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

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

mw version 0.08

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