source: subversion/applications/utils/gary68/mwMisc.pm @ 30595

Last change on this file since 30595 was 26548, checked in by gary68, 8 years ago

mapweaver now supports gpx files as well

File size: 18.7 KB
Line 
1#
2# PERL mapweaver module by gary68
3#
4#
5#
6#
7# Copyright (C) 2011, Gerhard Schwanz
8#
9# 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
10# Free Software Foundation; either version 3 of the License, or (at your option) any later version.
11#
12# This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
13# FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
14#
15# You should have received a copy of the GNU General Public License along with this program; if not, see <http://www.gnu.org/licenses/>
16#
17
18
19package mwMisc ; 
20
21use strict ;
22use warnings ;
23
24use Math::Trig;
25use Math::Polygon ;
26use List::Util qw[min max] ;
27
28use mwConfig ;
29use mwFile ;
30# use mwMap ;
31
32use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
33
34require Exporter ;
35
36@ISA = qw ( Exporter AutoLoader ) ;
37
38@EXPORT = qw (  getValue
39                createLabel
40                buildRings
41                angleMapgen
42                triangleNode
43                intersection
44                areaSize
45                isIn
46                processPageNumbers
47                processRectangles
48                sizePNG
49                sizeSVG
50                createDirPdf
51                getPointOfWay
52                nodes2Coordinates
53                areaCenter
54                createTextSVG
55                wayVisible
56                labelTransform
57                 ) ;
58
59
60
61sub getValue {
62        my ($key, $aRef) = @_ ;
63        my $value = undef ;
64        foreach my $kv (@$aRef) {
65                if ($kv->[0] eq $key) { $value = $kv->[1]; }
66        }
67        return $value ;
68}
69
70sub createLabel {
71#
72# takes @tags and labelKey(s) from style file and creates labelTextTotal and array of labels for directory
73# takes more keys in one string - using a separator.
74#
75# § all listed keys will be searched for and values be concatenated
76# # first of found keys will be used to select value
77# "name§ref" will return all values if given
78# "name#ref" will return name, if given. if no name is given, ref will be used. none given, no text
79#
80        my ($ref1, $styleLabelText, $lon, $lat) = @_ ;
81        my @tags = @$ref1 ;
82        my @keys ;
83        my @labels = () ;
84        my $labelTextTotal = "" ; 
85
86        if (grep /!/, $styleLabelText) { # AND
87                @keys = split ( /!/, $styleLabelText) ;
88                # print "par found: $styleLabelText; @keys\n" ;
89                for (my $i=0; $i<=$#keys; $i++) {
90                        if ($keys[$i] eq "_lat") { push @labels, $lat ; } 
91                        if ($keys[$i] eq "_lon") { push @labels, $lon ; } 
92                        foreach my $tag (@tags) {
93                                if ($tag->[0] eq $keys[$i]) {
94                                        push @labels, $tag->[1] ;
95                                }
96                        }
97                }
98                $labelTextTotal = "" ;
99                foreach my $label (@labels) { $labelTextTotal .= $label . " " ; }
100        }
101        else { # PRIO
102                @keys = split ( /#/, $styleLabelText) ;
103                my $i = 0 ; my $found = 0 ;
104                while ( ($i<=$#keys) and ($found == 0) ) {
105                        if ($keys[$i] eq "_lat") { push @labels, $lat ; $found = 1 ; $labelTextTotal = $lat ; } 
106                        if ($keys[$i] eq "_lon") { push @labels, $lon ; $found = 1 ; $labelTextTotal = $lon ; } 
107                        foreach my $tag (@tags) {
108                                if ($tag->[0] eq $keys[$i]) {
109                                        push @labels, $tag->[1] ;
110                                        $labelTextTotal = $tag->[1] ;
111                                        $found = 1 ;
112                                }
113                        }
114                        $i++ ;
115                }               
116        }
117        return ( $labelTextTotal, \@labels) ;
118}
119
120sub buildRings {
121#
122# accepts ref to array of ways and option if unclosed rings shoulf be returned
123# closeOpt == 1 returns only closed rings
124#
125# returns two refs to arrays of arrays: ways and nodes
126#
127        my ($ref, $closeOpt) = @_ ;
128        my (@allWays) = @$ref ;
129        my @ringWays = () ;
130        my @ringNodes = () ;
131        my $ringCount = 0 ;
132
133        my ($memWayNodesRef, $memWayTagsRef) = mwFile::getWayPointers() ;
134
135        # print "build rings for @allWays\n" ;
136        if (cv('debug') eq "1" ) { print "BR: called.\n" ; }
137        while ( scalar @allWays > 0) {
138                # build new test ring
139                my (@currentWays) = () ; my (@currentNodes) = () ;
140                push @currentWays, $allWays[0] ;
141                if (cv('debug') eq "1" ) { print "BR: initial way for next ring id= $allWays[0]\n" ; }
142                push @currentNodes, @{$$memWayNodesRef{$allWays[0]}} ;
143                my $startNode = $currentNodes[0] ;
144                my $endNode = $currentNodes[-1] ;
145                if (cv('debug') eq "1" ) { print "BR: initial start and end node $startNode $endNode\n" ; }
146                my $closed = 0 ;
147                shift @allWays ; # remove first element
148                if ($startNode == $endNode) {   $closed = 1 ; }
149
150                my $success = 1 ;
151                while ( ($closed == 0) and ( (scalar @allWays) > 0) and ($success == 1) ) {
152                        # try to find new way
153                        if (cv('debug') eq "1" ) { print "TRY TO FIND NEW WAY\n" ; }
154                        $success = 0 ;
155                        if (cv('debug') eq "1" ) { print "BR: actual start and end node $startNode $endNode\n" ; }
156                        my $i = 0 ;
157                        while ( ($i < (scalar @allWays) ) and ($success == 0) ) {
158                                if (cv('debug') eq "1" ) { print "BR: testing way $i = $allWays[$i]\n" ; }
159                                if (cv('debug') eq "1" ) { print "BR:   rev in front?\n" ; }
160                                if ( $$memWayNodesRef{$allWays[$i]}[0] == $startNode ) { 
161                                        $success = 1 ;
162                                        # reverse in front
163                                        @currentWays = ($allWays[$i], @currentWays) ;
164                                        @currentNodes = (reverse (@{$$memWayNodesRef{$allWays[$i]}}), @currentNodes) ;
165                                        splice (@allWays, $i, 1) ;
166                                }
167                                if ($success ==0) {
168                                        if (cv('debug') eq "1" ) { print "BR:   app at end?\n" ; }
169                                        if ( $$memWayNodesRef{$allWays[$i]}[0] == $endNode)  { 
170                                                $success = 1 ;
171                                                # append at end
172                                                @currentWays = (@currentWays, $allWays[$i]) ;
173                                                @currentNodes = (@currentNodes, @{$$memWayNodesRef{$allWays[$i]}}) ;
174                                                splice (@allWays, $i, 1) ;
175                                        }
176                                }
177                                if ($success ==0) {
178                                        if (cv('debug') eq "1" ) { print "BR:   app in front?\n" ; }
179                                        if ( $$memWayNodesRef{$allWays[$i]}[-1] == $startNode) { 
180                                                $success = 1 ;
181                                                # append in front
182                                                @currentWays = ($allWays[$i], @currentWays) ;
183                                                @currentNodes = (@{$$memWayNodesRef{$allWays[$i]}}, @currentNodes) ;
184                                                splice (@allWays, $i, 1) ;
185                                        }
186                                }
187                                if ($success ==0) {
188                                        if (cv('debug') eq "1" ) { print "BR:   rev at end?\n" ; }
189                                        if ( $$memWayNodesRef{$allWays[$i]}[-1] == $endNode) { 
190                                                $success = 1 ;
191                                                # append reverse at the end
192                                                @currentWays = (@currentWays, $allWays[$i]) ;
193                                                @currentNodes = (@currentNodes, (reverse (@{$$memWayNodesRef{$allWays[$i]}}))) ;
194                                                splice (@allWays, $i, 1) ;
195                                        }
196                                }
197                                $i++ ;
198                        } # look for new way that fits
199
200                        $startNode = $currentNodes[0] ;
201                        $endNode = $currentNodes[-1] ;
202                        if ($startNode == $endNode) { 
203                                $closed = 1 ; 
204                                if (cv('debug') eq "1" ) { print "BR: ring now closed\n" ;} 
205                        }
206                } # new ring
207               
208                # examine ring and act
209                if ( ($closed == 1) or ($closeOpt == 0) ) {
210                        # eliminate double nodes in @currentNodes
211                        my $found = 1 ;
212                        while ($found) {
213                                $found = 0 ;
214                                LABCN: for (my $i=0; $i<$#currentNodes; $i++) {
215                                        if ($currentNodes[$i] == $currentNodes[$i+1]) {
216                                                $found = 1 ;
217                                                splice @currentNodes, $i, 1 ;
218                                                last LABCN ;
219                                        }
220                                }
221                        }
222                        # add data to return data
223                        @{$ringWays[$ringCount]} = @currentWays ;
224                        @{$ringNodes[$ringCount]} = @currentNodes ;
225                        $ringCount++ ;
226                }
227        } 
228        return (\@ringWays, \@ringNodes) ;
229}
230
231sub angleMapgen {
232#
233# angle between lines/segments
234#
235        my ($g1x1) = shift ;
236        my ($g1y1) = shift ;
237        my ($g1x2) = shift ;
238        my ($g1y2) = shift ;
239        my ($g2x1) = shift ;
240        my ($g2y1) = shift ;
241        my ($g2x2) = shift ;
242        my ($g2y2) = shift ;
243
244        my $g1m ;
245        if ( ($g1x2-$g1x1) != 0 )  {
246                $g1m = ($g1y2-$g1y1)/($g1x2-$g1x1) ; # steigungen
247        }
248        else {
249                $g1m = 999999999 ;
250        }
251
252        my $g2m ;
253        if ( ($g2x2-$g2x1) != 0 ) {
254                $g2m = ($g2y2-$g2y1)/($g2x2-$g2x1) ;
255        }
256        else {
257                $g2m = 999999999 ;
258        }
259
260        if ($g1m == $g2m) {   # parallel
261                return (0) ;
262        }
263        else {
264                my $t1 = $g1m -$g2m ;
265                my $t2 = 1 + $g1m * $g2m ;
266                if ($t2 == 0) {
267                        return 90 ;
268                }
269                else {
270                        my $a = atan (abs ($t1/$t2)) / 3.141592654 * 180 ;
271                        return $a ;
272                }
273        }
274} 
275
276sub triangleNode {
277#
278# get segment of segment as coordinates
279# from start or from end of segment
280#
281        # 0 = start
282        # 1 = end
283        my ($x1, $y1, $x2, $y2, $len, $startEnd) = @_ ;
284        my ($c) = sqrt ( ($x2-$x1)**2 + ($y2-$y1)**2) ;
285        my $percent = $len / $c ;
286
287        my ($x, $y) ;
288        if ($startEnd == 0 ) { 
289                $x = $x1 + ($x2-$x1)*$percent ;
290                $y = $y1 + ($y2-$y1)*$percent ;
291        }
292        else {
293                $x = $x2 - ($x2-$x1)*$percent ;
294                $y = $y2 - ($y2-$y1)*$percent ;
295        }
296        return ($x, $y) ;
297}
298
299sub intersection {
300#
301# returns intersection point of two lines, else (0,0)
302#
303        my ($g1x1) = shift ;
304        my ($g1y1) = shift ;
305        my ($g1x2) = shift ;
306        my ($g1y2) = shift ;
307       
308        my ($g2x1) = shift ;
309        my ($g2y1) = shift ;
310        my ($g2x2) = shift ;
311        my ($g2y2) = shift ;
312
313        if (($g1x1 == $g2x1) and ($g1y1 == $g2y1)) { # p1 = p1 ?
314                return ($g1x1, $g1y1) ;
315        }
316        if (($g1x1 == $g2x2) and ($g1y1 == $g2y2)) { # p1 = p2 ?
317                return ($g1x1, $g1y1) ;
318        }
319        if (($g1x2 == $g2x1) and ($g1y2 == $g2y1)) { # p2 = p1 ?
320                return ($g1x2, $g1y2) ;
321        }
322
323        if (($g1x2 == $g2x2) and ($g1y2 == $g2y2)) { # p2 = p1 ?
324                return ($g1x2, $g1y2) ;
325        }
326
327        my $g1m ;
328        if ( ($g1x2-$g1x1) != 0 )  {
329                $g1m = ($g1y2-$g1y1)/($g1x2-$g1x1) ; # steigungen
330        }
331        else {
332                $g1m = 999999 ;
333        }
334
335        my $g2m ;
336        if ( ($g2x2-$g2x1) != 0 ) {
337                $g2m = ($g2y2-$g2y1)/($g2x2-$g2x1) ;
338        }
339        else {
340                $g2m = 999999 ;
341        }
342
343        if ($g1m == $g2m) {   # parallel
344                return (0, 0) ;
345        }
346
347        my ($g1b) = $g1y1 - $g1m * $g1x1 ; # abschnitte
348        my ($g2b) = $g2y1 - $g2m * $g2x1 ;
349
350        my ($sx) = ($g2b-$g1b) / ($g1m-$g2m) ;             # schnittpunkt
351        my ($sy) = ($g1m*$g2b - $g2m*$g1b) / ($g1m-$g2m);
352
353        my ($g1xmax) = max ($g1x1, $g1x2) ;
354        my ($g1xmin) = min ($g1x1, $g1x2) ;     
355        my ($g1ymax) = max ($g1y1, $g1y2) ;     
356        my ($g1ymin) = min ($g1y1, $g1y2) ;     
357
358        my ($g2xmax) = max ($g2x1, $g2x2) ;
359        my ($g2xmin) = min ($g2x1, $g2x2) ;     
360        my ($g2ymax) = max ($g2y1, $g2y2) ;     
361        my ($g2ymin) = min ($g2y1, $g2y2) ;     
362
363        if      (($sx >= $g1xmin) and
364                ($sx >= $g2xmin) and
365                ($sx <= $g1xmax) and
366                ($sx <= $g2xmax) and
367                ($sy >= $g1ymin) and
368                ($sy >= $g2ymin) and
369                ($sy <= $g1ymax) and
370                ($sy <= $g2ymax)) {
371                return ($sx, $sy) ;
372        }
373        else {
374                return (0, 0) ;
375        }
376} 
377
378
379sub isIn {
380# checks two polygons
381# return 0 = neither
382# 1 = p1 is in p2
383# 2 = p2 is in p1
384        my ($p1, $p2) = @_ ;
385
386        my ($p1In2) = 1 ;
387        my ($p2In1) = 1 ;
388
389        # p1 in p2 ?
390        foreach my $pt1 ($p1->points) {
391                if ($p2->contains ($pt1) ) {
392                        # good
393                }
394                else {
395                        $p1In2 = 0 ;
396                }
397        }
398
399        # p2 in p1 ?
400        foreach my $pt2 ($p2->points) {
401                if ($p1->contains ($pt2) ) {
402                        # good
403                }
404                else {
405                        $p2In1 = 0 ;
406                }
407        }
408
409        if ($p1In2 == 1) {
410                return 1 ;
411        }
412        elsif ($p2In1 == 1) {
413                return 2 ;
414        }
415        else {
416                return 0 ;
417        }
418}
419
420# -------------------------------------------------------------------------------
421
422sub processPageNumbers {
423        if ( cv('pageNumbers') ne "") {
424                my $pnSize ; my $pnColor ;
425                my @a = split /,/, cv('pageNumbers') ;
426                if (scalar @a >= 3) {
427                        $pnSize = $a[0] ;
428                        $pnColor = $a[1] ;
429                        my $pnNumber = $a[2] ;
430
431                        if ($pnNumber != 0) {
432                                drawPageNumber ($pnSize, $pnColor, $pnNumber) ;
433                        }
434                }
435                if (scalar @a == 7) {
436                        # draw 4 other positions if ne 0!!!
437                        if ($a[3] != 0) { # left
438                                drawPageNumberLeft ($pnSize, $pnColor, $a[3]) ;
439                        }
440                        if ($a[4] != 0) { # bottom
441                                drawPageNumberBottom ($pnSize, $pnColor, $a[4]) ;
442                        }
443                        if ($a[5] != 0) { # right
444                                drawPageNumberRight ($pnSize, $pnColor, $a[5]) ;
445                        }
446                        if ($a[6] != 0) { # top
447                                drawPageNumberTop ($pnSize, $pnColor, $a[6]) ;
448                        }
449                }
450        }
451}
452
453sub drawPageNumber {
454        my ($size, $col, $num) = @_ ;
455        my ($sizeX, $sizeY) = mwMap::getDimensions() ;
456        my $x = $sizeX - 2 * $size ;
457        my $y = $sizeY - 2 * $size ;
458        my $svgString = "fill=\"$col\" font-size=\"$size\" " ;
459        mwMap::drawText ($x, $y, 0, $num, $svgString, "text")
460}
461
462sub drawPageNumberLeft {
463        my ($size, $col, $num) = @_ ;
464        my ($sizeX, $sizeY) = mwMap::getDimensions() ;
465        my $x = 2 * $size ;
466        my $y = $sizeY / 2 ;
467        my $svgString = "fill=\"$col\" font-size=\"$size\" " ;
468        mwMap::drawText ($x, $y, 0, $num, $svgString, "text")
469}
470
471sub drawPageNumberBottom {
472        my ($size, $col, $num) = @_ ;
473        my ($sizeX, $sizeY) = mwMap::getDimensions() ;
474        my $x = $sizeX / 2 ;
475        my $y = $sizeY - 2 * $size ;
476        my $svgString = "fill=\"$col\" font-size=\"$size\" " ;
477        mwMap::drawText ($x, $y, 0, $num, $svgString, "text")
478}
479
480sub drawPageNumberRight {
481        my ($size, $col, $num) = @_ ;
482        my ($sizeX, $sizeY) = mwMap::getDimensions() ;
483        my $x = $sizeX - 2 * $size ;
484        my $y = $sizeY / 2 ;
485        my $svgString = "fill=\"$col\" font-size=\"$size\" " ;
486        mwMap::drawText ($x, $y, 0, $num, $svgString, "text")
487}
488
489sub drawPageNumberTop {
490        my ($size, $col, $num) = @_ ;
491        my ($sizeX, $sizeY) = mwMap::getDimensions() ;
492        my $x = $sizeX / 2 ;
493        my $y = 2 * $size ;
494        my $svgString = "fill=\"$col\" font-size=\"$size\" " ;
495        mwMap::drawText ($x, $y, 0, $num, $svgString, "text")
496}
497
498# ---------------------------------------------------------------------
499
500sub processRectangles {
501        my $no = 0 ;
502
503        if ( cv('rectangles') ne "") {
504                my @rects ;
505                @rects = split /#/, cv('rectangles') ;
506                foreach my $r (@rects) {
507                        $no++ ;
508                        my @coords ;
509                        @coords = split /,/, $r ;
510
511                        my $left = $coords[0] ;
512                        my $bottom = $coords[1] ;
513                        my $right = $coords[2] ;
514                        my $top = $coords[3] ;
515
516                        my @nodes ;
517                        push @nodes, convert ($left, $bottom) ;
518                        push @nodes, convert ($right, $bottom) ;
519                        push @nodes, convert ($right, $top) ;
520                        push @nodes, convert ($left, $top) ;
521                        push @nodes, convert ($left, $bottom) ;
522       
523                        # drawWay (10, "black", 5, "none", @nodes) ;
524                        my $svgString = "fill=\"none\" stroke=\"black\" stroke-width=\"7\" " ;
525                        drawWay (\@nodes, 0, $svgString, "rectangles", undef) ;
526                        # drawRect ($left, $bottom, $right, $top, 1, $svgString, "rectangles") ;
527
528                        if ( cv('pagenumbers') ne "") {
529                                my $x = ($right + $left) / 2 ;
530                                my $y = ($bottom + $top) / 2 ;
531                                my $xp ; my $yp ;
532                                ($xp, $yp) = convert ($x, $y) ;
533                                # drawTextPixGrid ($xp, $yp, $no, $pnColor, scalePoints ( scaleBase ($pnSize) ) ) ;
534                                my $svgString = "fill=\"black\" font-size=\"60\" " ;
535                                drawText ($xp, $yp, 0, $no, $svgString, "rectangles") ;
536                        }
537
538                }
539        }
540}
541
542# --------------------------------------------------------------------
543
544sub sizePNG {
545#
546# evaluates size of png graphics
547#
548        my $fileName = shift ;
549
550        my ($x, $y) ;
551        my $file ;
552        my $result = open ($file, "<", $fileName) ;
553        if ($result) {
554                my $pic = newFromPng GD::Image($file) ;
555                ($x, $y) = $pic->getBounds ;
556                close ($file) ;
557        }
558        else {
559                ($x, $y) = (0, 0) ;
560        }
561        return ($x, $y) ;
562}
563
564sub sizeSVG {
565#
566# evaluates size of svg graphics
567#
568        my $fileName = shift ;
569        my $file ;
570        my ($x, $y) ; undef $x ; undef $y ;
571
572        my $result = open ($file, "<", $fileName) ;
573        if ($result) {
574                my $line ;
575                while ($line = <$file>) {
576                        my ($x1) = ( $line =~ /^.*width=\"([\d]+)px\"/ ) ; 
577                        my ($y1) = ( $line =~ /^.*height=\"([\d]+)px\"/ ) ;
578                        if (!defined $x1) {
579                                ($x1) = ( $line =~ /^\s*width=\"([\d]+)\"/ ) ; 
580
581                        } 
582                        if (!defined $y1) {
583                                ($y1) = ( $line =~ /^\s*height=\"([\d]+)\"/ ) ; 
584                        } 
585                        if (defined $x1) { $x = $x1 ; }
586                        if (defined $y1) { $y = $y1 ; }
587                }
588                close ($file) ;
589        }
590
591        if ( (!defined $x) or (!defined $y) ) { 
592                $x = 0 ; $y = 0 ; 
593                print "WARNING: size of file $fileName could not be determined.\n" ;
594        } 
595        return ($x, $y) ;
596}
597
598# ------------------------------------------------------------------------
599
600
601sub createDirPdf {
602        if ((cv('dir') eq "1") or (cv('poi') eq "1")) {
603                if (cv('grid') > 0) {
604                        my $dirPdfName = cv('out') ;
605                        $dirPdfName =~ s/.svg/_dir.pdf/ ;
606                        my $sName = "none" ;
607                        my $pName = "none" ;
608
609                        my $prg = cv ('dirprg') ;                       
610
611                        if (cv('dir') eq "1") { $sName = cv('directoryname') ; }
612                        if (cv('poi') eq "1") { $pName = cv('poiname') ; }
613                        my $dirColNum = cv ('dircolnum') ;
614                        my $dirTitle = cv ('dirtitle') ;
615                        print "\ncalling perl $prg $sName $pName $dirTitle $dirPdfName $dirColNum\n\n" ;
616                        `perl $prg $sName $pName \"$dirTitle\" $dirPdfName $dirColNum > out.txt` ;
617                }
618                else {
619                        print "WARNING: directory PDF will not be created because -grid was not specified\n" ;
620                }
621               
622        }
623        else {
624                print "WARNING: directory PDF will not be created because neither -dir nor -poi was specified\n" ;
625        }
626}
627
628# -----------------------------------------------------------------------------
629
630sub getPointOfWay {
631        #
632        # returns point of way at distance/position
633        # coordinates and units are pixels
634
635        my ($ref, $position) = @_ ;
636        my @points = @$ref ;
637
638        my @double = () ;
639        while (scalar @points > 0) {
640                my $x = shift @points ;
641                my $y = shift @points ;
642                push @double, [$x, $y] ;
643        }
644
645        my $i = 0 ; my $actLen = 0 ;
646        while ($actLen < $position) {
647                $actLen += sqrt ( ($double[$i]->[0]-$double[$i+1]->[0])**2 + ($double[$i]->[1]-$double[$i+1]->[1])**2 ) ;
648                $i++ ;
649        }
650
651        my $x = int (($double[$i]->[0] +  $double[$i-1]->[0]) / 2) ;
652        my $y = int (($double[$i]->[1] +  $double[$i-1]->[1]) / 2) ;
653
654        # print "POW: $x, $y\n" ;
655
656        return ($x, $y) ;
657}
658
659# ----------------------------------------------------------------
660
661sub nodes2Coordinates {
662#
663# transform list of nodeIds to list of x/y
664# straight array in and out
665#
666        my @nodes = @_ ;
667        my $i ;
668
669        my @result = () ;
670
671        my ($lonRef, $latRef) = mwFile::getNodePointers() ;
672
673        foreach my $n (@nodes) {
674                my ($x, $y) = mwMap::convert ( $$lonRef{$n}, $$latRef{$n}) ;
675                push @result, $x, $y ;
676        }
677
678        return @result ;
679}
680
681
682sub areaCenter {
683#
684# calculate center of area by averageing lons/lats. could be smarter because result could be outside of area! TODO
685#
686        my $ref = shift ;
687        my @nodes = @$ref ;
688
689        # print "CENTER: @nodes\n" ;
690
691        my $x = 0 ;
692        my $y = 0 ;
693        my $num = 0 ;
694
695        my ($lonRef, $latRef) = getNodePointers() ;
696
697        foreach my $n (@nodes) {
698                $x +=  $$lonRef{$n} ;
699                $y +=  $$latRef{$n} ;
700                $num++ ;
701        }
702        $x = $x / $num ;
703        $y = $y / $num ;
704        return ($x, $y) ;
705
706}
707
708
709sub areaSize {
710        my $ref = shift ; # nodes
711        my @nodes = @$ref ;
712
713        # print "SIZE: @nodes\n" ;
714
715        my ($lonRef, $latRef) = mwFile::getNodePointers() ;
716
717        my @poly = () ;
718        foreach my $node ( @nodes ) {
719                my ($x, $y) = mwMap::convert ($$lonRef{$node}, $$latRef{$node}) ;
720                push @poly, [$x, $y] ;
721        }
722        my ($p) = Math::Polygon->new(@poly) ;
723        my $size = $p->area ;
724
725        return $size ;
726}
727
728# ---------------------------------------------------------------
729
730sub createTextSVG {
731        my ($fontFamily, $font, $bold, $italic, $size, $color, $strokeWidth, $strokeColor) = @_ ;
732
733        my $svg = "" ;
734
735        if ( (defined $font) and ( $font ne "") ) {
736                $svg .= "font=\"$font\" " ;
737        }
738        if ( (defined $fontFamily) and ( $fontFamily ne "") ) {
739                $svg .= "font-family=\"$fontFamily\" " ;
740        }
741
742        if ( (defined $bold) and ( lc ($bold) eq "yes") ) {
743                $svg .= "font-weight=\"bold\" " ;
744        }
745        if ( (defined $italic) and ( lc ($italic) eq "yes") ) {
746                $svg .= "font-style=\"italic\" " ;
747        }
748
749        if ( (defined $size) and ( $size ne "") ) {
750                $svg .= "font-size=\"$size\" " ;
751        }
752        if ( (defined $color) and ( $color ne "") ) {
753                $svg .= "fill=\"$color\" " ;
754        }
755
756        if ( (defined $strokeColor) and ( $strokeColor ne "") ) {
757                $svg .= "stroke=\"$strokeColor\" " ;
758        }
759        if ( (defined $strokeWidth) and ( $strokeWidth ne "") ) {
760                $svg .= "stroke-width=\"$strokeWidth\" " ;
761        }
762
763       
764
765        return $svg ;
766}
767
768# --------------------------------------------------------------------
769
770sub wayVisible {
771        my $ref = shift ;
772        my @points = @$ref ;
773        my ($sizeX, $sizeY) = mwMap::getDimensions() ;
774
775        my $result = 0 ;
776
777        for (my $i = 0; $i < $#points; $i += 2) {
778                my $x = $points[$i] ;
779                my $y = $points[$i+1] ;
780                if ( ( $x >= 0 ) and ( $y >= 0 ) and ( $x <= $sizeX ) and ( $y <= $sizeY ) ) {
781                        $result = 1 ;
782                }
783        }
784        return $result ;
785}
786
787# --------------------------------------------------------------------
788
789sub labelTransform {
790        my ($label, $cmd) = @_ ;
791        if ($cmd ne "") {
792                eval $cmd ;
793                if ($@) { print "ERROR  processing label '$label' with command: '$cmd'\nERROR: $@\n" ; }
794        }
795        return $label ;
796}
797
798
7991 ;
800
801
Note: See TracBrowser for help on using the repository browser.