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

Last change on this file since 26424 was 26272, checked in by gary68, 8 years ago

new mapweaver version 0.12

File size: 12.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 mwWayLabel ; 
20
21use strict ;
22use warnings ;
23
24use mwConfig ;
25use mwFile ;
26use mwMisc ;
27use mwMap ;
28use mwLabel ;
29
30use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
31
32require Exporter ;
33
34@ISA = qw ( Exporter AutoLoader ) ;
35
36@EXPORT = qw (  addToDirectory
37                getDirectory
38                addWayLabel
39                preprocessWayLabels
40                createWayLabels
41                 ) ;
42
43my %directory = () ;
44my %wayLabels = () ;
45my @labelCandidates = () ;
46my %ruleRefs = () ;
47my $pathNumber = 0 ;
48
49my $numWayLabelsOmitted = 0 ;
50
51sub addToDirectory {
52        my ($name, $square) = @_ ;
53        if ( ! defined $square ) {
54                $directory { $name } = 1 ;
55        }
56        else {
57                $directory { $name } { $square } = 1 ;
58        }
59}
60
61sub getDirectory {
62        return \%directory ;
63}
64
65sub addWayLabel {
66#
67# collect all way label data before actual labeling
68#
69        my ($wayId, $name, $ruleRef) = @_ ;
70        push @{ $wayLabels{$ruleRef}{$name} }, $wayId ;
71        $ruleRefs{$ruleRef} = $ruleRef ;
72        if ( cv ('debug') eq "1" ) {
73                print "AWL: $wayId, $name, $ruleRef\n" ;
74        }
75}
76
77sub preprocessWayLabels {
78#
79# preprocess way labels collected so far
80# combine ways with same rule and name
81# split ways where direction in longitude changes so labels will be readable later
82# store result in @labelCandidates
83#
84
85        my ($lonRef, $latRef) = getNodePointers() ;
86        my ($memWayNodesRef, $memWayTagsRef) = getWayPointers() ;
87
88        foreach my $rule (keys %wayLabels) {
89                my $ruleRef = $ruleRefs{ $rule } ;
90                # print "PPWL: ruleNum $rule\n" ;
91                foreach my $name (keys %{$wayLabels{$rule}}) {
92                        my (@ways) = @{$wayLabels{$rule}{$name}} ;
93                        # print "PPWL:    processing name $name, " . scalar (@ways) . " ways\n" ;
94                        my ($waysRef, $nodesRef) = buildRings (\@ways, 0) ;
95                        my @segments = @$nodesRef ;
96                        # print "PPWL:    processing name $name, " . scalar (@segments) . " segments\n" ;
97
98                        if ( ! grep /shield/i, $name) {
99
100                                my @newSegments = () ;
101                                foreach my $segment (@segments) {
102                                        my @actual = @$segment ;
103                                        # print "PPWL: Actual segment @actual\n" ;
104                                        my $found = 1 ;
105                                        while ($found) {
106                                                $found = 0 ; my $sp = 0 ;
107                                                # look for splitting point
108                                                LABSP: for (my $i=1; $i<$#actual; $i++) {
109                                                        if ( (($$lonRef{$actual[$i-1]} > $$lonRef{$actual[$i]}) and ($$lonRef{$actual[$i+1]} > $$lonRef{$actual[$i]})) or 
110                                                                (($$lonRef{$actual[$i-1]} < $$lonRef{$actual[$i]}) and ($$lonRef{$actual[$i+1]} < $$lonRef{$actual[$i]})) ) {
111                                                                $found = 1 ;
112                                                                $sp = $i ;
113                                                                last LABSP ;
114                                                        }
115                                                }
116                                                if ($found == 1) {
117                                                        # print "\nname $name --- sp: $sp\n" ;
118                                                        # print "ACTUAL BEFORE: @actual\n" ;
119                                                        # create new seg
120                                                        my @newSegment = @actual[0..$sp] ;
121                                                        push @newSegments, [@newSegment] ;
122                                                        # print "NEW: @newSegment\n" ;
123
124                                                        # splice actual
125                                                        splice @actual, 0, $sp ;
126                                                        # print "ACTUAL AFTER: @actual\n\n" ;
127                                                }
128                                        }
129                                        @$segment = @actual ;
130                                }
131
132                                push @segments, @newSegments ;
133
134                        }
135
136                        foreach my $segment (@segments) {
137                                my (@wayNodes) = @$segment ;
138                                my @points = () ;
139
140                                if ($$lonRef{$wayNodes[0]} > $$lonRef{$wayNodes[-1]}) {
141                                        if ( ( ! grep /motorway/, $$ruleRef{'keyvalue'}) and ( ! grep /trunk/, $$ruleRef{'keyvalue'} ) ) {
142                                                @wayNodes = reverse @wayNodes ;
143                                        }
144                                }
145
146                                foreach my $node (@wayNodes) {
147                                        push @points, convert ($$lonRef{$node}, $$latRef{$node}) ;
148                                }
149                                # print "PPWL:      segment @wayNodes\n" ;
150                                # print "PPWL:      segment @points\n" ;
151
152                                my ($segmentLengthPixels) = 0 ; 
153
154
155                                for (my $i=0; $i<$#wayNodes; $i++) {
156                                        my ($x1, $y1) = convert ($$lonRef{$wayNodes[$i]}, $$latRef{$wayNodes[$i]}) ;
157                                        my ($x2, $y2) = convert ($$lonRef{$wayNodes[$i+1]}, $$latRef{$wayNodes[$i+1]}) ;
158                                        $segmentLengthPixels += sqrt ( ($x2-$x1)**2 + ($y2-$y1)**2 ) ;
159                                }
160                                # print "$rule, $wayIndexLabelSize\n" ;
161
162                                my $labelLengthPixels = 0 ;
163
164                                if (grep /shield/i, $$ruleRef{'label'} ) {
165                                        $labelLengthPixels = $$ruleRef{'labelsize'} ;
166                                        # print "PPWL: len = $labelLengthPixels\n" ;
167                                }
168                                else {
169                                        $labelLengthPixels = length ($name) * cv('ppc') / 10 * $$ruleRef{'labelsize'} ;
170                                }
171
172                                # print "\nPPWL:        name $name - ppc $ppc - size $ruleArray[$wayIndexLabelSize]\n" ;
173                                # print "PPWL:        wayLen $segmentLengthPixels\n" ;
174                                # print "PPWL:        labLen $labelLengthPixels\n" ;
175
176                                push @labelCandidates, [$rule, $name, $segmentLengthPixels, $labelLengthPixels, [@points]] ;
177                                if ( cv('debug') eq "1") {
178                                        print "PLC: $rule, $name, $segmentLengthPixels, $labelLengthPixels\n" ;
179                                }
180                        }
181                }
182        }
183}
184
185sub subWay {
186#
187# takes coordinates and label information and creates new way/path
188# also calculates total angles / bends
189#
190        my ($ref, $labLen, $alignment, $position) = @_ ;
191        my @coordinates = @$ref ;
192        my @points ;
193        my @dists ;
194        my @angles = () ;
195
196        for (my $i=0; $i < $#coordinates; $i+=2) {
197                push @points, [$coordinates[$i],$coordinates[$i+1]] ;
198        }
199
200        $dists[0] = 0 ;
201        my $dist = 0 ;
202        if (scalar @points > 1) {
203                for (my $i=1;$i<=$#points; $i++) {
204                        $dist = $dist + sqrt ( ($points[$i-1]->[0]-$points[$i]->[0])**2 + ($points[$i-1]->[1]-$points[$i]->[1])**2 ) ;
205                        $dists[$i] = $dist ;
206                }                       
207        }
208
209        # calc angles at nodes
210        if (scalar @points > 2) {
211                for (my $i=1;$i<$#points; $i++) {
212                        $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]) ;
213                }                       
214        }
215
216        my $wayLength = $dist ;
217        my $refPoint = $wayLength / 100 * $position ;
218        my $labelStart ; my $labelEnd ;
219        if ($alignment eq "start") { # left
220                $labelStart = $refPoint ;
221                $labelEnd = $labelStart + $labLen ;
222        }
223        if ($alignment eq "end") { # right
224                $labelEnd = $refPoint ;
225                $labelStart = $labelEnd - $labLen ;
226        }
227        if ($alignment eq "middle") { # center
228                $labelEnd = $refPoint + $labLen / 2 ;
229                $labelStart = $refPoint - $labLen / 2 ;
230        }
231
232        # find start and end segments
233        my $startSeg ; my $endSeg ;
234        for (my $i=0; $i<$#points; $i++) {
235                if ( ($dists[$i]<=$labelStart) and ($dists[$i+1]>=$labelStart) ) { $startSeg = $i ; }
236                if ( ($dists[$i]<=$labelEnd) and ($dists[$i+1]>=$labelEnd) ) { $endSeg = $i ; }
237        }
238
239        my @finalWay = () ;
240        my $finalAngle = 0 ;
241        my ($sx, $sy) = triangleNode ($coordinates[$startSeg*2], $coordinates[$startSeg*2+1], $coordinates[$startSeg*2+2], $coordinates[$startSeg*2+3], $labelStart-$dists[$startSeg], 0) ;
242        push @finalWay, $sx, $sy ;
243
244        if ($startSeg != $endSeg) {
245                for (my $i=$startSeg+1; $i<=$endSeg; $i++) { 
246                        push @finalWay, $coordinates[$i*2], $coordinates[$i*2+1] ; 
247                        $finalAngle += abs ($angles[$i]) ;
248                }
249        }
250
251        my ($ex, $ey) = triangleNode ($coordinates[$endSeg*2], $coordinates[$endSeg*2+1], $coordinates[$endSeg*2+2], $coordinates[$endSeg*2+3], $labelEnd-$dists[$endSeg], 0) ;
252        push @finalWay, $ex, $ey ;
253       
254        return (\@finalWay, $finalAngle) ;     
255}
256
257sub createWayLabels {
258#
259# finally take all way label candidates and try to label them
260#
261
262        print "placing way labels...\n" ;
263
264        my %notDrawnLabels = () ;
265        my %drawnLabels = () ;
266
267        # calc ratio to label ways first where label just fits
268        # these will be drawn first
269        foreach my $candidate (@labelCandidates) {
270                my $wLen = $candidate->[2] ;
271                my $lLen = $candidate->[3] ;
272                if ($wLen == 0) { $wLen = 1 ; }
273                if ($lLen == 0) { $lLen = 1 ; }
274                $candidate->[5] = $lLen / $wLen ;
275        }
276        @labelCandidates = sort { $b->[5] <=> $a->[5] } @labelCandidates ;
277
278        foreach my $candidate (@labelCandidates) {
279                my $ruleRef = $ruleRefs{ $candidate->[0] } ;
280                my $name = $candidate->[1] ;
281                my $wLen = $candidate->[2] ;
282                my $lLen = $candidate->[3] ;
283                my @points = @{$candidate->[4]} ;
284
285                my $toLabel = 1 ;
286                if ( ( cv('declutter') eq "1") and ($points[0] > $points[-2]) and 
287                        ( ( grep /motorway/i, $$ruleRef{'keyvalue'}) or (grep /trunk/i, $$ruleRef{'keyvalue'}) ) ) {
288                        $toLabel = 0 ;
289                }
290
291                if ($lLen > $wLen*0.95) {
292                        $notDrawnLabels { $name } = 1 ;
293                }
294
295                if ( ($lLen > $wLen*0.95) or ($toLabel == 0) ) {
296                        # label too long
297                        $numWayLabelsOmitted++ ;
298                }
299                else {
300
301                        if (grep /shield/i, $name) {
302
303                                createShield ($name, $$ruleRef{'labelsize'} ) ;
304
305                                my $shieldMaxSize = getMaxShieldSize ($name) ;
306
307                                my $numShields = int ($wLen / ($shieldMaxSize * 12) ) ;
308                                # if ($numShields > 4) { $numShields = 4 ; }
309
310                                if ($numShields > 0) {
311                                        my $step = $wLen / ($numShields + 1) ;
312                                        my $position = $step ; 
313                                        while ($position < $wLen) {
314                                                my ($x, $y) = getPointOfWay (\@points, $position) ;
315                                                # print "XY: $x, $y\n" ;
316
317                                                # place shield if not occupied
318                       
319                                                my ($ssx, $ssy) = getShieldSizes($name) ;
320
321                                                my $x2 = int ($x - $ssx / 2) ;
322                                                my $y2 = int ($y - $ssy / 2) ;
323
324                                                # print "AREA: $x2, $y2, $x2+$lLen, $y2+$lLen\n" ;
325
326                                                if ( ! mwLabel::areaOccupied ($x2, $x2+$ssx, $y2+$ssy, $y2) ) {
327
328                                                        my $id = getShieldId ($name) ;
329                                                        addToLayer ("shields", "<use xlink:href=\"#$id\" x=\"$x2\" y=\"$y2\" />") ;
330
331                                                        mwLabel::occupyArea ($x2, $x2+$ssx, $y2+$ssy, $y2) ;
332                                                }
333
334                                                $position += $step ;
335                                        }
336                                }
337
338                        } # shield
339
340                        else { 
341
342                                # print "$wLen - $name - $lLen\n" ;
343                                my $numLabels = int ($wLen / (4 * $lLen)) ;
344                                if ($numLabels < 1) { $numLabels = 1 ; }
345                                if ($numLabels > 4) { $numLabels = 4 ; }
346
347                                if ($numLabels == 1) {
348                                        my $spare = 0.95 * $wLen - $lLen ;
349                                        my $sparePercentHalf = $spare / ($wLen*0.95) *100 / 2 ;
350                                        my $startOffset = 50 - $sparePercentHalf ;
351                                        my $endOffset = 50 + $sparePercentHalf ;
352                                        # five possible positions per way
353                                        my $step = ($endOffset - $startOffset) / 5 ;
354                                        my @positions = () ;
355                                        my $actual = $startOffset ;
356                                        while ($actual <= $endOffset) {
357                                                my ($ref, $angle) = subWay (\@points, $lLen, "middle", $actual) ;
358                                                my @way = @$ref ;
359                                                my ($col) = lineCrossings (\@way) ;
360                                                # calc quality of position. distance from middle and bend angles
361                                                my $quality = $angle + abs (50 - $actual) ;
362                                                if ($col == 0) { push @positions, ["middle", $actual, $quality] ; }
363                                                $actual += $step ;
364                                        }
365                                        if (scalar @positions > 0) {
366                                                $drawnLabels { $name } = 1 ;
367                                                # sort by quality and take best one
368                                                @positions = sort {$a->[2] <=> $b->[2]} @positions ;
369                                                my ($pos) = shift @positions ;
370                                                my ($ref, $angle) = subWay (\@points, $lLen, $pos->[0], $pos->[1]) ;
371                                                my @finalWay = @$ref ;
372
373
374
375
376
377
378                                                my $pathName = "Path" . $pathNumber ; $pathNumber++ ;
379                                                createPath ($pathName, \@points, "definitions") ;
380
381                                                my $size = $$ruleRef{'labelsize'} ;
382                                                my $color = $$ruleRef{'labelcolor'} ;
383                                                my $font = $$ruleRef{'labelfont'} ;
384                                                my $svgText = "font-size=\"$size\" font-family=\"$font\" fill=\"$color\"" ; 
385                                                pathText ($svgText, $name, $pathName, $$ruleRef{'labeloffset'}, $pos->[0], $pos->[1], "text") ;
386
387
388
389
390                                                occupyLines (\@finalWay) ;
391                                        }
392                                        else {
393                                                $numWayLabelsOmitted++ ;
394                                        }
395                                }
396                                else { # more than one label
397                                        my $labelDrawn = 0 ;
398                                        my $interval = int (100 / ($numLabels + 1)) ;
399                                        my @positions = () ;
400                                        for (my $i=1; $i<=$numLabels; $i++) {
401                                                push @positions, $i * $interval ;
402                                        }
403                       
404                                        foreach my $position (@positions) {
405                                                my ($refFinal, $angle) = subWay (\@points, $lLen, "middle", $position) ;
406                                                my (@finalWay) = @$refFinal ;
407                                                my ($collision) = lineCrossings (\@finalWay) ;
408                                                if ($collision == 0) {
409                                                        $labelDrawn = 1 ;
410                                                        $drawnLabels { $name } = 1 ;
411                                                        my $pathName = "Path" . $pathNumber ; $pathNumber++ ;
412
413                                                        createPath ($pathName, \@points, "definitions") ;
414
415                                                        my $size = $$ruleRef{'labelsize'} ;
416                                                        my $color = $$ruleRef{'labelcolor'} ;
417                                                        my $font = $$ruleRef{'labelfont'} ;
418                                                        my $svgText = "font-size=\"$size\" font-family=\"$font\" fill=\"$color\"" ; 
419                                                        pathText ($svgText, $name, $pathName, $$ruleRef{'labeloffset'}, "middle", 50, "text") ;
420
421                                                        occupyLines (\@finalWay) ;
422
423
424
425                                                }
426                                                else {
427                                                        # print "INFO: $name labeled less often than desired.\n" ;
428                                                }
429                                        }
430                                        if ($labelDrawn == 0) {
431                                                $notDrawnLabels { $name } = 1 ;
432                                        }
433                                }
434                        }
435                }
436        }
437        my $labelFileName = cv('out') ;
438        $labelFileName =~ s/\.svg/_NotDrawnLabels.txt/ ;
439        my $labelFile ;
440        open ($labelFile, ">", $labelFileName) or die ("couldn't open label file $labelFileName") ;
441        print $labelFile "Not drawn labels\n\n" ;
442        foreach my $labelName (sort keys %notDrawnLabels) {
443                if (!defined $drawnLabels { $labelName } ) {
444                        print $labelFile "$labelName\n" ;
445                }
446        }
447        close ($labelFile) ;
448
449}
450
4511 ;
452
453
Note: See TracBrowser for help on using the repository browser.