source: subversion/applications/utils/gary68/mwRelations.pm @ 26313

Revision 26313, 9.0 KB checked in by gary68, 3 years ago (diff)

new mapweaver versions

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 mwRelations ; 
20
21use strict ;
22use warnings ;
23
24use mwMap ;
25use mwRules ;
26use mwFile ;
27use mwMisc ;
28use mwLabel ;
29use mwConfig ;
30
31use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
32
33require Exporter ;
34
35@ISA = qw ( Exporter AutoLoader ) ;
36
37@EXPORT = qw ( processRoutes
38
39                 ) ;
40
41my $pathNumber = 0 ;
42
43my %iconSizeX = () ;
44my %iconSizeY = () ;
45
46
47# --------------------------------------------------------------------------
48
49sub processRoutes {
50#
51# process route data
52#
53        my %routeColors = () ;
54        my %actualColorIndex = () ;
55        my %colorNumber = () ;
56        my %wayRouteLabels = () ;
57        my %wayRouteIcons = () ;
58        my (%iconSizeX, %iconSizeY) ;
59
60        print "processing routes...\n" ;
61
62        # init before relation processing
63        my $ref = getRouteColors() ;
64        %routeColors = %$ref ;
65        foreach my $type (keys %routeColors) {
66                $colorNumber{$type} = scalar @{$routeColors{$type}} ;
67                $actualColorIndex{$type} = 0 ;
68        }
69
70        my ($lonRef, $latRef) = getNodePointers() ;
71        my ($wayNodesRef, $wayTagsRef) = getWayPointers() ;
72        my ($relationMembersRef, $relationTagsRef) = getRelationPointers() ;
73
74        foreach my $relId (keys %$relationTagsRef) {
75                my $relationType = getValue ("type", $$relationTagsRef{$relId} ) ;
76                if ( ! defined $relationType ) { $relationType = "" ; }
77
78                print "    $relId, $relationType\n" ;
79
80                if ( ( $relationType eq "route" ) and ( (cv('relid') == $relId) or (cv('relid') == 0) ) ) {
81
82                        my $ruleRef = getRouteRule( $$relationTagsRef{$relId} ) ;
83
84                        if (defined $ruleRef) {
85
86                                # new route detected
87                                if (cv('debug') eq "1" ) { print "ROUTE: rule found for $relId, $$ruleRef{'type'}.\n" ; }
88       
89
90                                # try to get color from relation tags first
91                                #
92                                my $color = getValue ("color", $$relationTagsRef{$relId} ) ;
93                                if ( ! defined $color) {
94                                        $color = getValue ("colour", $$relationTagsRef{$relId} ) ;
95                                }
96                                # no color yet, then get color from rule
97                                #
98                                if ( ! defined $color) { 
99                                        if (cv('debug') eq "1" ) { print "ROUTE:   actual color index: $actualColorIndex{ $$ruleRef{'type'} }\n" ; }
100                                        $color = $routeColors{ $$ruleRef{'type'} }[$actualColorIndex{ $$ruleRef{'type'} }] ; 
101                                        $actualColorIndex{ $$ruleRef{'type'} } = ($actualColorIndex{ $$ruleRef{'type'} } + 1) % $colorNumber{ $$ruleRef{'type'} } ;
102                                }
103                                if (cv('debug') eq "1" ) { print "ROUTE:   final color: $color\n" ; }
104
105                                # find icon
106                                my $iconName = getValue ("ref", $$relationTagsRef{$relId} ) ;
107                                if ($iconName eq "") {
108                                        getValue ("name", $$relationTagsRef{$relId} )
109                                }
110
111                                my $file ;
112                                $iconName = cv('icondir') . $$ruleRef{'type'} . "-" . $iconName . ".svg" ;
113                                my $iconResult = open ($file, "<", $iconName) ;
114                                # print "  trying $iconName\n" ;
115                                if ($iconResult) { 
116                                        if (cv('debug') eq "1") { print "ROUTE:   icon $iconName found!\n" ; }
117                                        close ($file) ;
118                                } 
119
120                                if (!$iconResult) {
121                                        $iconName =~ s/.svg/.png/ ; 
122                                        # print "  trying $iconName\n" ;
123                                        $iconResult = open ($file, "<", $iconName) ;
124                                        if ($iconResult) { 
125                                                if (cv('debug') eq "1") { print "ROUTE:   icon $iconName found!\n" ; }
126                                                close ($file) ;
127                                        } 
128                                }
129
130                                if ($iconResult) {
131                                        my ($x, $y) ; undef $x ; undef $y ;
132                                        if (grep /.svg/, $iconName) {
133                                                ($x, $y) = sizeSVG ($iconName) ;
134                                                if ( ($x == 0) or ($y == 0) ) { 
135                                                        $x = 32 ; $y = 32 ; 
136                                                        print "WARNING: size of file $iconName could not be determined. Set to 32px x 32px\n" ;
137                                                } 
138                                        }
139
140                                        if (grep /.png/, $iconName) {
141                                                ($x, $y) = sizePNG ($iconName) ;
142                                        }
143
144                                        $iconSizeX{$iconName} = $x ;
145                                        $iconSizeY{$iconName} = $y ;
146                                }
147
148                                my ($label, $ref) = createLabel ( $$relationTagsRef{$relId}, $$ruleRef{'label'} ) ;
149                                if (cv('debug') eq "1" ) { print "ROUTE:   label: $label\n" ; }
150
151                                my $printIcon = "" ; if ($iconResult) { $printIcon=$iconName ; }
152                                       
153                                if (cv('debug') eq "1" ) { 
154                                        printf "ROUTE: route %10s %10s %10s %30s %40s\n", $relId, $$ruleRef{'type'}, $color, $label, $printIcon ; 
155                                }
156
157                                # collect ways
158
159                                my $mRef = getAllMembers ($relId, 0) ;
160                                my @tempMembers = @$mRef ;
161
162                                my @relWays = () ;
163                                foreach my $member (@tempMembers) {
164                                        if ( ( ($member->[2] eq "none") or ($member->[2] eq "route") ) and ($member->[0] eq "way") ) { push @relWays, $member->[1] ; }
165                                        if ( ( ($member->[2] eq "forward") or ($member->[2] eq "backward") ) and ($member->[0] eq "way") ) { push @relWays, $member->[1] ; }
166
167                                        # stops
168                                        if ( (grep /stop/, $member->[2]) and ($member->[0] eq "node") ) {
169                                                # print "stop found in route $relId\n" ;
170                                                if ( $$ruleRef{'nodesize'} > 0) {
171                                                        my $svgString = "fill=\"$color\" " ;
172                                                        drawCircle ($$lonRef{$member->[1]}, $$latRef{$member->[1]}, 1, $$ruleRef{'nodesize'}, 0, $svgString, 'routes') ;
173                                                }
174                                        }
175                                }
176
177                                if (cv('debug') eq "1" ) { print "ROUTE:   ways: @relWays\n" ; }
178
179                                foreach my $w (@relWays) {
180
181                                        my $op = $$ruleRef{'opacity'} ;
182                                        my $width = $$ruleRef{'size'} ;
183       
184                                        my $svgString = "stroke=\"$color\" stroke-opacity=\"$op\" stroke-width=\"$width\" " ;
185                                        drawWay ($$wayNodesRef{$w}, 1, $svgString, "routes", undef) ;
186
187                                        # collect labels and icons per way
188                                        #
189                                        $wayRouteLabels{$w}{$label} = 1 ;
190                                        if ($iconResult) {                                             
191                                                $wayRouteIcons{$w}{$iconName} = 1 ;
192                                        }
193                                }
194
195                        } # rule found
196                        # if (cv('debug') eq "1") { print "\n" ; }
197                } # rel route
198        }
199
200        # label route ways after all relations have been processed
201        foreach my $w (keys %wayRouteLabels) {
202                if ( (defined $$wayNodesRef{$w}) and (scalar @{$$wayNodesRef{$w}} > 1) ) {
203                        my $label = "" ;
204                        foreach my $l (keys %{$wayRouteLabels{$w}}) {
205                                $label .= $l . " " ;
206                        } 
207
208                        my @way = @{$$wayNodesRef{$w}} ;
209                        if ($$lonRef{$way[0]} > $$lonRef{$way[-1]}) {
210                                @way = reverse (@way) ;
211                        }
212
213                        if (labelFitsWay ($$wayNodesRef{$w}, $label, cv('routelabelfont'), cv('routelabelsize') ) ) {
214                                my $pathName = "RoutePath" . $pathNumber ; 
215                                $pathNumber++ ;
216
217                                my @points = nodes2Coordinates( @{ $$wayNodesRef{$w} }) ;
218                                createPath ($pathName, \@points, "definitions") ;
219
220                                my $size = cv('routelabelsize') ;
221                                my $color = cv('routelabelcolor') ;
222                                my $svgText = "font-size=\"$size\" fill=\"$color\"" ; 
223                                pathText ($svgText, $label, $pathName, cv('routelabeloffset'), "middle", 50, "routes") ;
224                        }
225                }
226        }
227
228        foreach my $w (keys %wayRouteIcons) {
229                my $offset = 0 ;
230                my $nodeNumber = scalar @{$$wayNodesRef{$w}} ;
231                if ($nodeNumber > 1) {
232                        my $node = $$wayNodesRef{$w}[int ($nodeNumber / 2)] ;
233                        my $num = scalar (keys %{$wayRouteIcons{$w}}) ;
234                        $offset = int (-($num-1)* cv('routeicondist') / 2) ; 
235
236                        foreach my $iconName (keys %{$wayRouteIcons{$w}}) {
237
238                                my $size = 40 ;
239                                placeLabelAndIcon ($$lonRef{$node}, $$latRef{$node}, $offset, $size, "", "", $iconName, $iconSizeX{$iconName}, $iconSizeY{$iconName}, "routes") ;
240
241                                $offset += cv('routeicondist') ;
242                        }
243                }
244        }
245}
246
247# --------------------------------------------------------------------------
248
249sub getAllMembers {
250#
251# get all members of a relation recursively
252# takes rel id and nesting level
253# retruns ref to array with all members
254#
255        my ($relId, $nestingLevel) = @_ ;
256        my @allMembers = () ;
257        my $maxNestingLevel = 20 ;
258
259        my ($relationMembersRef, $relationTagsRef) = getRelationPointers() ;
260
261        if ($nestingLevel > $maxNestingLevel) { 
262                print "ERROR/WARNING nesting level of relations too deep. recursion stopped at depth $maxNestingLevel! relId=$relId\n" ;
263        }
264        else {
265                foreach my $member ( @{$$relationMembersRef{$relId}} ) {
266                        if ( ($member->[0] eq "way") or ($member->[0] eq "node") ) {
267                                push @allMembers, $member ;
268                        }
269                        if ( $member->[0] eq "relation" ) {
270                                my $ref = getAllMembers ($member->[1], $nestingLevel+1) ;
271                                push @allMembers, @$ref ;
272                        }
273                }       
274        }
275        return \@allMembers ;
276}
277
278sub labelFitsWay {
279        my ($refWayNodes, $text, $font, $size) = @_ ;
280        my @wayNodes = @$refWayNodes ;
281
282        my ($lonRef, $latRef) = getNodePointers() ;
283
284        # calc waylen
285        my $wayLength = 0 ; # in pixels
286        for (my $i=0; $i<$#wayNodes; $i++) {
287                my ($x1, $y1) = convert ($$lonRef{$wayNodes[$i]}, $$latRef{$wayNodes[$i]}) ;
288                my ($x2, $y2) = convert ($$lonRef{$wayNodes[$i+1]}, $$latRef{$wayNodes[$i+1]}) ;
289                $wayLength += sqrt ( ($x2-$x1)**2 + ($y2-$y1)**2 ) ;
290        }
291
292
293        # calc label len
294        my $labelLength = length ($text) * cv('ppc') / 10 * $size ; # in pixels
295
296        my $fit ;
297        if ($labelLength < $wayLength) { $fit="fit" ; } else { $fit = "NOFIT" ; }
298        # print "labelFitsWay: $fit, $text, labelLen = $labelLength, wayLen = $wayLength\n" ;
299
300        if ($labelLength < $wayLength) {
301                return 1 ;
302        }
303        else {
304                return 0 ;
305        }
306}
307
308
3091 ;
310
311
Note: See TracBrowser for help on using the repository browser.