source: subversion/applications/utils/gary68/mwWayLabel.pm

Last change on this file was 29098, checked in by gary68, 7 years ago

shield error in mapweaver corrected

File size: 16.3 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 mwWayLabel ; 
20
21use strict ;
22use warnings ;
23
24use mwConfig ;
25use mwFile ;
26use mwMisc ;
27use mwMap ;
28use mwLabel ;
29use mwOccupy ;
30
31use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
32
33require Exporter ;
34
35@ISA = qw ( Exporter AutoLoader ) ;
36
37@EXPORT = qw (  addToDirectory
38                getDirectory
39                addWayLabel
40                preprocessWayLabels
41                createWayLabels
42                 ) ;
43
44my %directory = () ;
45my %wayLabels = () ;
46my @labelCandidates = () ;
47my %ruleRefs = () ;
48my $pathNumber = 0 ;
49
50my $numWayLabelsOmitted = 0 ;
51my $wnsNumber = 1 ;
52my @wns =() ;
53
54
55# ------------------------------------------------------------------------
56
57sub addToDirectory {
58        my ($name, $square) = @_ ;
59        if ( ! defined $square ) {
60                $directory { $name } = 1 ;
61        }
62        else {
63                $directory { $name } { $square } = 1 ;
64        }
65}
66
67sub getDirectory {
68        return \%directory ;
69}
70
71sub addWayLabel {
72#
73# collect all way label data before actual labeling
74#
75        my ($wayId, $name, $ruleRef) = @_ ;
76        push @{ $wayLabels{$ruleRef}{$name} }, $wayId ;
77        $ruleRefs{$ruleRef} = $ruleRef ;
78        if ( cv ('debug') eq "1" ) {
79                print "AWL: $wayId, $name, $ruleRef\n" ;
80        }
81}
82
83sub preprocessWayLabels {
84#
85# preprocess way labels collected so far
86# combine ways with same rule and name
87# split ways where direction in longitude changes so labels will be readable later
88# store result in @labelCandidates
89#
90
91        my ($lonRef, $latRef) = getNodePointers() ;
92        my ($memWayNodesRef, $memWayTagsRef) = getWayPointers() ;
93
94        foreach my $rule (keys %wayLabels) {
95                my $ruleRef = $ruleRefs{ $rule } ;
96                # print "PPWL: ruleNum $rule\n" ;
97                foreach my $name (keys %{$wayLabels{$rule}}) {
98                        my (@ways) = @{$wayLabels{$rule}{$name}} ;
99                        # print "PPWL:    processing name $name, " . scalar (@ways) . " ways\n" ;
100                        my ($waysRef, $nodesRef) = buildRings (\@ways, 0) ;
101                        my @segments = @$nodesRef ;
102                        # print "PPWL:    processing name $name, " . scalar (@segments) . " segments\n" ;
103
104                        if ( ! grep /shield:/i, $name) {
105
106                                my @newSegments = () ;
107                                foreach my $segment (@segments) {
108                                        my @actual = @$segment ;
109                                        # print "PPWL: Actual segment @actual\n" ;
110                                        my $found = 1 ;
111                                        while ($found) {
112                                                $found = 0 ; my $sp = 0 ;
113                                                # look for splitting point
114                                                LABSP: for (my $i=1; $i<$#actual; $i++) {
115                                                        if ( (($$lonRef{$actual[$i-1]} > $$lonRef{$actual[$i]}) and ($$lonRef{$actual[$i+1]} > $$lonRef{$actual[$i]})) or 
116                                                                (($$lonRef{$actual[$i-1]} < $$lonRef{$actual[$i]}) and ($$lonRef{$actual[$i+1]} < $$lonRef{$actual[$i]})) ) {
117                                                                $found = 1 ;
118                                                                $sp = $i ;
119                                                                last LABSP ;
120                                                        }
121                                                }
122                                                if ($found == 1) {
123                                                        # print "\nname $name --- sp: $sp\n" ;
124                                                        # print "ACTUAL BEFORE: @actual\n" ;
125                                                        # create new seg
126                                                        my @newSegment = @actual[0..$sp] ;
127                                                        push @newSegments, [@newSegment] ;
128                                                        # print "NEW: @newSegment\n" ;
129
130                                                        # splice actual
131                                                        splice @actual, 0, $sp ;
132                                                        # print "ACTUAL AFTER: @actual\n\n" ;
133                                                }
134                                        }
135                                        @$segment = @actual ;
136                                }
137
138                                push @segments, @newSegments ;
139
140                        }
141
142                        foreach my $segment (@segments) {
143                                my (@wayNodes) = @$segment ;
144                                my @points = () ;
145
146                                if ($$lonRef{$wayNodes[0]} > $$lonRef{$wayNodes[-1]}) {
147                                        if ( ( ! grep /motorway/, $$ruleRef{'keyvalue'}) and ( ! grep /trunk/, $$ruleRef{'keyvalue'} ) ) {
148                                                @wayNodes = reverse @wayNodes ;
149                                        }
150                                }
151
152                                foreach my $node (@wayNodes) {
153                                        push @points, convert ($$lonRef{$node}, $$latRef{$node}) ;
154                                }
155                                # print "PPWL:      segment @wayNodes\n" ;
156                                # print "PPWL:      segment @points\n" ;
157
158                                my ($segmentLengthPixels) = 0 ; 
159
160
161                                for (my $i=0; $i<$#wayNodes; $i++) {
162                                        my ($x1, $y1) = convert ($$lonRef{$wayNodes[$i]}, $$latRef{$wayNodes[$i]}) ;
163                                        my ($x2, $y2) = convert ($$lonRef{$wayNodes[$i+1]}, $$latRef{$wayNodes[$i+1]}) ;
164                                        $segmentLengthPixels += sqrt ( ($x2-$x1)**2 + ($y2-$y1)**2 ) ;
165                                }
166                                # print "$rule, $wayIndexLabelSize\n" ;
167
168                                my $labelLengthPixels = 0 ;
169
170                                if (grep /shield/i, $$ruleRef{'label'} ) {
171                                        $labelLengthPixels = $$ruleRef{'labelsize'} ;
172                                        # print "PPWL: len = $labelLengthPixels\n" ;
173                                }
174                                else {
175                                        $labelLengthPixels = length ($name) * cv('ppc') / 10 * $$ruleRef{'labelsize'} ;
176                                }
177
178                                # print "\nPPWL:        name $name - ppc $ppc - size $ruleArray[$wayIndexLabelSize]\n" ;
179                                # print "PPWL:        wayLen $segmentLengthPixels\n" ;
180                                # print "PPWL:        labLen $labelLengthPixels\n" ;
181
182                                push @labelCandidates, [$rule, $name, $segmentLengthPixels, $labelLengthPixels, [@points]] ;
183                                if ( cv('debug') eq "1") {
184                                        print "PLC: $rule, $name, $segmentLengthPixels, $labelLengthPixels\n" ;
185                                }
186                        }
187                }
188        }
189}
190
191sub subWay {
192#
193# takes coordinates and label information and creates new way/path
194# also calculates total angles / bends
195#
196        my ($ref, $labLen, $alignment, $position) = @_ ;
197        my @coordinates = @$ref ;
198        my @points ;
199        my @dists ;
200        my @angles = () ;
201
202        for (my $i=0; $i < $#coordinates; $i+=2) {
203                push @points, [$coordinates[$i],$coordinates[$i+1]] ;
204        }
205
206        $dists[0] = 0 ;
207        my $dist = 0 ;
208        if (scalar @points > 1) {
209                for (my $i=1;$i<=$#points; $i++) {
210                        $dist = $dist + sqrt ( ($points[$i-1]->[0]-$points[$i]->[0])**2 + ($points[$i-1]->[1]-$points[$i]->[1])**2 ) ;
211                        $dists[$i] = $dist ;
212                }                       
213        }
214
215        # calc angles at nodes
216        if (scalar @points > 2) {
217                for (my $i=1;$i<$#points; $i++) {
218                        $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]) ;
219                }                       
220        }
221
222        my $wayLength = $dist ;
223        my $refPoint = $wayLength / 100 * $position ;
224        my $labelStart ; my $labelEnd ;
225        if ($alignment eq "start") { # left
226                $labelStart = $refPoint ;
227                $labelEnd = $labelStart + $labLen ;
228        }
229        if ($alignment eq "end") { # right
230                $labelEnd = $refPoint ;
231                $labelStart = $labelEnd - $labLen ;
232        }
233        if ($alignment eq "middle") { # center
234                $labelEnd = $refPoint + $labLen / 2 ;
235                $labelStart = $refPoint - $labLen / 2 ;
236        }
237
238        # find start and end segments
239        my $startSeg ; my $endSeg ;
240        for (my $i=0; $i<$#points; $i++) {
241                if ( ($dists[$i]<=$labelStart) and ($dists[$i+1]>=$labelStart) ) { $startSeg = $i ; }
242                if ( ($dists[$i]<=$labelEnd) and ($dists[$i+1]>=$labelEnd) ) { $endSeg = $i ; }
243        }
244
245        my @finalWay = () ;
246        my $finalAngle = 0 ;
247        my ($sx, $sy) = triangleNode ($coordinates[$startSeg*2], $coordinates[$startSeg*2+1], $coordinates[$startSeg*2+2], $coordinates[$startSeg*2+3], $labelStart-$dists[$startSeg], 0) ;
248        push @finalWay, $sx, $sy ;
249
250        if ($startSeg != $endSeg) {
251                for (my $i=$startSeg+1; $i<=$endSeg; $i++) { 
252                        push @finalWay, $coordinates[$i*2], $coordinates[$i*2+1] ; 
253                        $finalAngle += abs ($angles[$i]) ;
254                }
255        }
256
257        my ($ex, $ey) = triangleNode ($coordinates[$endSeg*2], $coordinates[$endSeg*2+1], $coordinates[$endSeg*2+2], $coordinates[$endSeg*2+3], $labelEnd-$dists[$endSeg], 0) ;
258        push @finalWay, $ex, $ey ;
259       
260        return (\@finalWay, $finalAngle) ;     
261}
262
263sub createWayLabels {
264#
265# finally take all way label candidates and try to label them
266#
267
268        my %wnsUnique = () ;
269        print "placing way labels...\n" ;
270
271        my %notDrawnLabels = () ;
272        my %drawnLabels = () ;
273
274        # calc ratio to label ways first where label just fits
275        # these will be drawn first
276        foreach my $candidate (@labelCandidates) {
277                my $wLen = $candidate->[2] ;
278                my $lLen = $candidate->[3] ;
279                if ($wLen == 0) { $wLen = 1 ; }
280                if ($lLen == 0) { $lLen = 1 ; }
281                $candidate->[5] = $lLen / $wLen ;
282        }
283        @labelCandidates = sort { $b->[5] <=> $a->[5] } @labelCandidates ;
284
285        foreach my $candidate (@labelCandidates) {
286                my $ruleRef = $ruleRefs{ $candidate->[0] } ;
287                my $name = $candidate->[1] ;
288                my $wLen = $candidate->[2] ;
289                my $lLen = $candidate->[3] ;
290                my @points = @{$candidate->[4]} ;
291
292                my $toLabel = 1 ;
293                if ( ( cv('declutter') eq "1") and ($points[0] > $points[-2]) and 
294                        ( ( grep /motorway/i, $$ruleRef{'keyvalue'}) or (grep /trunk/i, $$ruleRef{'keyvalue'}) ) ) {
295                        $toLabel = 0 ;
296                }
297
298
299                # wns?
300                if ( ($lLen > $wLen * 0.95) and ( cv('wns') > 0 ) ) {
301                        if ( ( $toLabel != 0 ) and ( ! grep /shield:/i, $name) and ( wayVisible( \@points ) ) ) {
302                                if ( ! defined $wnsUnique{$name} ) {
303                                        my $oldName = $name ;
304                                        $wnsUnique{$name} = 1 ;
305                                        push @wns, [ $wnsNumber, $name] ;
306                                        $name = $wnsNumber ;
307                                        $lLen = cv('ppc') / 10 * $$ruleRef{'labelsize'} * length ($name) ;
308                                        # print "WNS: $oldName - $name\n" ;
309                                        $wnsNumber++ ;
310                                }
311                        }
312                }
313
314
315                if ( ($lLen > $wLen*0.95) or ($toLabel == 0) ) {
316                        # label too long
317                        $numWayLabelsOmitted++ ;
318                        $notDrawnLabels { $name } = 1 ;
319
320                }
321                else {
322
323                        if (grep /shield:/i, $name) {
324
325                                createShield ($name, $$ruleRef{'labelsize'} ) ;
326
327                                my $shieldMaxSize = getMaxShieldSize ($name) ;
328
329                                my $numShields = int ($wLen / ($shieldMaxSize * 12) ) ;
330                                # if ($numShields > 4) { $numShields = 4 ; }
331
332                                if ($numShields > 0) {
333                                        my $step = $wLen / ($numShields + 1) ;
334                                        my $position = $step ; 
335                                        while ($position < $wLen) {
336                                                my ($x, $y) = getPointOfWay (\@points, $position) ;
337                                                # print "XY: $x, $y\n" ;
338                                               
339                                                if ( ! coordsOut ($x, $y) ) {
340
341                                                        # place shield if not occupied
342                       
343                                                        my ($ssx, $ssy) = getShieldSizes($name) ;
344
345                                                        my $x2 = int ($x - $ssx / 2) ;
346                                                        my $y2 = int ($y - $ssy / 2) ;
347
348                                                        # print "AREA: $x2, $y2, $x2+$lLen, $y2+$lLen\n" ;
349
350                                                        if ( ! mwLabel::boxAreaOccupied ($x2, $y2+$ssy, $x2+$ssx, $y2) ) {
351
352                                                                my $id = getShieldId ($name) ;
353                                                                addToLayer ("shields", "<use xlink:href=\"#$id\" x=\"$x2\" y=\"$y2\" />") ;
354
355                                                                mwLabel::boxOccupyArea ($x2, $y2+$ssy, $x2+$ssx, $y2, 0, 3) ;
356                                                        }
357                                                }
358
359                                                $position += $step ;
360                                        }
361                                }
362
363                        } # shield
364
365                        else { 
366
367                                # print "$wLen - $name - $lLen\n" ;
368                                my $numLabels = int ($wLen / (4 * $lLen)) ;
369                                if ($numLabels < 1) { $numLabels = 1 ; }
370                                if ($numLabels > 4) { $numLabels = 4 ; }
371
372                                if ($numLabels == 1) {
373                                        # print "LA: $name *1*\n" ;
374                                        my $spare = 0.95 * $wLen - $lLen ;
375                                        my $sparePercentHalf = $spare / ($wLen*0.95) *100 / 2 ;
376                                        my $startOffset = 50 - $sparePercentHalf ;
377                                        my $endOffset = 50 + $sparePercentHalf ;
378                                        # five possible positions per way
379                                        my $step = ($endOffset - $startOffset) / 5 ;
380                                        my @positions = () ;
381                                        my $actual = $startOffset ;
382                                        my $size = $$ruleRef{'labelsize'} ;
383                                        while ($actual <= $endOffset) {
384                                                my ($ref, $angle) = subWay (\@points, $lLen, "middle", $actual) ;
385                                                my @way = @$ref ;
386                                                # my ($col) = lineCrossings (\@way) ;
387                                                my ($col) = boxLinesOccupied (\@way, $size/2) ;
388                                                # calc quality of position. distance from middle and bend angles
389                                                my $quality = $angle + abs (50 - $actual) ;
390                                                if ($col == 0) { push @positions, ["middle", $actual, $quality] ; }
391                                                $actual += $step ;
392                                        }
393                                        if (scalar @positions > 0) {
394                                                $drawnLabels { $name } = 1 ;
395                                                # sort by quality and take best one
396                                                @positions = sort {$a->[2] <=> $b->[2]} @positions ;
397                                                my ($pos) = shift @positions ;
398                                                my ($ref, $angle) = subWay (\@points, $lLen, $pos->[0], $pos->[1]) ;
399                                                my @finalWay = @$ref ;
400       
401                                                # TODO IF INSIDE
402                                                # print "final way @finalWay\n" ;
403
404                                                if ( ! coordsOut (@finalWay) ) {
405                                                        my $pathName = "Path" . $pathNumber ; $pathNumber++ ;
406                                                        createPath ($pathName, \@finalWay, "definitions") ;
407
408                                                        my $size = $$ruleRef{'labelsize'} ;
409                                                        my $color = $$ruleRef{'labelcolor'} ;
410                                                        my $font = $$ruleRef{'labelfont'} ;
411                                                        my $fontFamily = $$ruleRef{'labelfontfamily'} ;
412                                                        my $labelBold = $$ruleRef{'labelbold'} ;
413                                                        my $labelItalic = $$ruleRef{'labelitalic'} ;
414                                                        my $labelHalo = $$ruleRef{'labelhalo'} ;
415                                                        my $labelHaloColor = $$ruleRef{'labelhalocolor'} ;
416
417                                                        my $svgText = createTextSVG ( $fontFamily, $font, $labelBold, $labelItalic, $size, $color, $labelHalo, $labelHaloColor) ; 
418                                                        # pathText ($svgText, $name, $pathName, $$ruleRef{'labeloffset'}, $pos->[0], $pos->[1], "text") ;
419                                                        pathText ($svgText, $name, $pathName, $$ruleRef{'labeloffset'}, $pos->[0], 50, "text") ;
420
421                                                        boxOccupyLines (\@finalWay, $size/2, 3) ;
422                                                }
423                                        }
424                                        else {
425                                                $numWayLabelsOmitted++ ;
426                                        }
427                                }
428                                else { # more than one label
429                                        # print "LA: $name *X*\n" ;
430                                        my $labelDrawn = 0 ;
431                                        my $interval = int (100 / ($numLabels + 1)) ;
432                                        my @positions = () ;
433                                        for (my $i=1; $i<=$numLabels; $i++) {
434                                                push @positions, $i * $interval ;
435                                        }
436                       
437                                        foreach my $position (@positions) {
438                                                my ($refFinal, $angle) = subWay (\@points, $lLen, "middle", $position) ;
439                                                my (@finalWay) = @$refFinal ;
440                                                # my ($collision) = lineCrossings (\@finalWay) ;
441
442                                                my $size = $$ruleRef{'labelsize'} ;
443                                                my ($collision) = boxLinesOccupied (\@finalWay, $size/2 ) ;
444
445                                                if ($collision == 0) {
446                                                        $labelDrawn = 1 ;
447                                                        $drawnLabels { $name } = 1 ;
448                                                        my $pathName = "Path" . $pathNumber ; $pathNumber++ ;
449
450                                                        # createPath ($pathName, \@points, "definitions") ;
451                                                        createPath ($pathName, \@finalWay, "definitions") ;
452
453                                                        my $size = $$ruleRef{'labelsize'} ;
454                                                        my $color = $$ruleRef{'labelcolor'} ;
455                                                        my $font = $$ruleRef{'labelfont'} ;
456                                                        my $fontFamily = $$ruleRef{'labelfontfamily'} ;
457                                                        my $labelBold = $$ruleRef{'labelbold'} ;
458                                                        my $labelItalic = $$ruleRef{'labelitalic'} ;
459                                                        my $labelHalo = $$ruleRef{'labelhalo'} ;
460                                                        my $labelHaloColor = $$ruleRef{'labelhalocolor'} ;
461
462                                                        my $svgText = createTextSVG ( $fontFamily, $font, $labelBold, $labelItalic, $size, $color, $labelHalo, $labelHaloColor) ; 
463                                                        pathText ($svgText, $name, $pathName, $$ruleRef{'labeloffset'}, "middle", 50, "text") ;
464
465                                                        boxOccupyLines (\@finalWay, $size/2, 3) ;
466
467
468
469                                                }
470                                                else {
471                                                        # print "INFO: $name labeled less often than desired.\n" ;
472                                                }
473                                        }
474                                        if ($labelDrawn == 0) {
475                                                $notDrawnLabels { $name } = 1 ;
476                                        }
477                                }
478                        }
479                }
480        }
481        my $labelFileName = cv('out') ;
482        $labelFileName =~ s/\.svg/_NotDrawnLabels.txt/ ;
483        my $labelFile ;
484        open ($labelFile, ">", $labelFileName) or die ("couldn't open label file $labelFileName") ;
485        print $labelFile "Not drawn labels\n\n" ;
486        foreach my $labelName (sort keys %notDrawnLabels) {
487                if (!defined $drawnLabels { $labelName } ) {
488                        print $labelFile "$labelName\n" ;
489                }
490        }
491        close ($labelFile) ;
492
493
494        # way name substitutes legend?
495
496        if ( cv('wns') > 0 ) {
497                createWNSLegend() ;
498        }
499
500}
501
502# ------------------------------------------------------------
503
504sub createWNSLegend {
505        my $size = cv('wnssize') ;     
506        my $color = cv('wnscolor') ;
507
508        # TODO max len auto size
509        my $maxLen = 0 ;
510        foreach my $e ( @wns ) {
511                if ( length $e->[1] > $maxLen ) { $maxLen = length $e->[1] ; }
512        }
513
514        my $sy = 2 * $size ;
515        my $sx = (4 + $maxLen) * $size / 10 * cv('ppc') ;
516        my $tx = 4 * $size / 10 * cv('ppc') ;
517        my $nx = 1 * $size / 10 * cv('ppc') ;
518        my $ty = 1.5 * $size ;
519
520        my $sizeX = $sx ;
521        my $sizeY = $sy * scalar @wns ;
522
523        # defs
524
525        my $actualLine = 0 ;
526
527        addToLayer ("definitions", "<g id=\"wnsdef\" width=\"$sizeX\" height=\"$sizeY\" >") ;
528
529        # bg
530        my $bg = cv('wnsbgcolor') ;
531        my $svgString = "fill=\"$bg\"" ;
532        drawRect (0, 0, $sizeX, $sizeY, 0, $svgString, "definitions") ;
533
534        $svgString = createTextSVG ( cv('elementFontFamily'), cv('elementFont'), undef, undef, cv('wnssize'), cv('wnscolor'), undef, undef) ;
535        foreach my $e ( @wns ) {
536                my $y = $actualLine * $sy + $ty ;
537                drawText ($nx, $y, 0, $e->[0], $svgString, "definitions") ;
538                drawText ($tx, $y, 0, $e->[1], $svgString, "definitions") ;
539               
540                $actualLine++ ;
541        }
542
543        addToLayer ("definitions", "</g>") ;
544
545        my $posX = 0 ;
546        my $posY = 0 ;
547
548        # reset some variables
549        ($sizeX, $sizeY) = getDimensions() ;
550        $sy = $sy * scalar @wns ;
551
552        if ( cv('wns') eq "2") {
553                $posX = $sizeX - $sx ;
554                $posY = 0 ;
555        }
556
557        if ( cv('wns') eq "3") {
558                $posX = 0 ;
559                $posY = $sizeY - $sy ;
560        }
561
562        if ( cv('wns') eq "4") {
563                $posX = $sizeX - $sx ;
564                $posY = $sizeY - $sy ;
565        }
566
567        if ( ( cv('wns') >=1 ) and ( cv('wns') <= 4 ) ) {
568                addToLayer ("wns", "<use x=\"$posX\" y=\"$posY\" xlink:href=\"#wnsdef\" />") ;
569        }
570
571        if ( cv('wns') eq "5") {
572                createLegendFile ($sx, $sy, "_wns", "#wnsdef") ;
573        }
574}
575
5761 ;
577
578
Note: See TracBrowser for help on using the repository browser.