source: subversion/applications/utils/gary68/mwRules.pm @ 26191

Revision 26191, 12.1 KB checked in by gary68, 3 years ago (diff)

mapweaver version 0.7

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 mwRules ; 
20
21use strict ;
22use warnings ;
23
24use mwConfig ;
25use mwMap ;
26
27use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
28
29require Exporter ;
30
31@ISA = qw ( Exporter AutoLoader ) ;
32
33@EXPORT = qw (  readRules
34                        getNodeRule
35                        printNodeRules
36                        getWayRule
37                        printWayRules
38                        getAreaRule
39                        printAreaRules
40                        printValidObjectProperties
41                 ) ;
42
43my @validNodeProperties = qw (  keyValue
44                                                color
45                                                size
46                                                shape
47                                                svgString
48                                                circle
49                                                circleColor
50                                                circleRadius
51                                                circleThickness
52                                                circleSVGString
53                                                disc
54                                                discColor
55                                                discOpacity
56                                                discRadius
57                                                discSVGString
58                                                label
59                                                labelColor
60                                                labelSize
61                                                labelFont
62                                                labelOffset
63                                                legend
64                                                legendLabel
65                                                icon
66                                                iconSize
67                                                shieldName
68                                                shieldSize
69                                                shieldLabel
70                                                fromScale
71                                                toScale
72                                        ) ;
73
74my @validWayProperties = qw (   keyValue
75                                        color
76                                        size
77                                        dash
78                                        borderColor
79                                        borderSize
80                                        label
81                                        labelColor
82                                        labelSize
83                                        labelFont
84                                        labelOffset
85
86                                        svgStringBottom
87                                        svgStringTop
88                                        bottomBorder
89                                       
90                                        fromScale
91                                        toScale
92                                        ) ;
93
94my @validAreaProperties = qw (  keyValue
95                                                color
96                                                icon
97                                                base
98                                                svgString
99                                                fromScale
100                                                toScale
101                                        ) ;
102
103
104
105my %nodeRules = () ;
106my %areaRules = () ;
107my %wayRules = () ;
108my $nodeNr = 0 ;
109my $areaNr = 0 ;
110my $wayNr = 0 ;
111
112# ---------------------------------------------------------------------------------------
113
114sub printValidObjectProperties {
115
116        print "\nValid Object Properties\n" ;
117
118        print "\nNodes\n-----\n" ;
119        foreach my $p (sort @validNodeProperties) {
120                print "$p\n" ;
121        }
122        print "\nWays\n----\n" ;
123        foreach my $p (sort @validWayProperties) {
124                print "$p\n" ;
125        }
126        print "\nAreas\n-----\n" ;
127        foreach my $p (sort @validAreaProperties) {
128                print "$p\n" ;
129        }
130        print "\n" ;
131}
132
133
134# ---------------------------------------------------------------------------------------
135
136
137sub readRules {
138
139        my $fileName = cv('style') ;
140        my $nrr = 0 ; my $wrr = 0 ; my $arr = 0 ; my $rrr = 0 ; my $crr = 0 ;
141
142        print "reading rule file $fileName\n" ;
143
144        my %vnp = () ;
145        foreach my $p ( @validNodeProperties ) { $vnp{ lc ( $p ) } = 1 ; }
146
147        my %vwp = () ;
148        foreach my $p ( @validWayProperties ) { $vwp{ lc ( $p ) } = 1 ; }
149
150        my %vap = () ;
151        foreach my $p ( @validAreaProperties ) { $vap{ lc ( $p ) } = 1 ; }
152
153        open (my $file, "<", $fileName) or die ("ERROR: could not open rule file $fileName\n") ;
154        my $line = "" ;
155        $line = <$file> ;
156        while (defined $line) {
157                $line =~ s/\r//g ; # remove dos/win char at line end
158                if ( grep /^rule node/i, $line ) {
159                        $nodeNr++ ;
160                        $nrr++ ;
161                        $line = <$file> ;
162
163                        # set defaults first
164                        $nodeRules{ $nodeNr }{ 'size' } = cv( 'ruleDefaultNodeSize' ) ;
165                        $nodeRules{ $nodeNr }{ 'color' } = cv( 'ruleDefaultNodeColor' ) ;
166                        $nodeRules{ $nodeNr }{ 'shape' } = cv( 'ruleDefaultNodeShape' ) ;
167
168                        $nodeRules{ $nodeNr }{ 'label' } = cv( 'ruleDefaultNodeLabel' ) ;
169                        $nodeRules{ $nodeNr }{ 'labelsize' } = cv( 'ruleDefaultNodeLabelSize' ) ;
170                        $nodeRules{ $nodeNr }{ 'icon' } = "none" ;
171                        $nodeRules{ $nodeNr }{ 'iconsize' } = cv( 'ruleDefaultNodeIconSize' ) ;
172                        $nodeRules{ $nodeNr }{ 'legend' } = "no" ;
173                        $nodeRules{ $nodeNr }{ 'shieldname' } = "none" ;
174                        $nodeRules{ $nodeNr }{ 'svgstring' } = "" ;
175
176                        $nodeRules{ $nodeNr }{ 'circle' } = 'no' ;
177                        $nodeRules{ $nodeNr }{ 'circlecolor' } = 'black' ;
178                        $nodeRules{ $nodeNr }{ 'circleradius' } = 1000 ;
179                        $nodeRules{ $nodeNr }{ 'circlethickness' } = 10 ;
180                        $nodeRules{ $nodeNr }{ 'circlesvgstring' } = "" ;
181
182                        $nodeRules{ $nodeNr }{ 'disc' } = 'no' ;
183                        $nodeRules{ $nodeNr }{ 'disccolor' } = 'red' ;
184                        $nodeRules{ $nodeNr }{ 'discopacity' } = 50 ;
185                        $nodeRules{ $nodeNr }{ 'discradius' } = 1000 ;
186                        $nodeRules{ $nodeNr }{ 'discradius' } = 1000 ;
187                        $nodeRules{ $nodeNr }{ 'discsvgstring' } = '' ;
188
189                        $nodeRules{ $nodeNr }{ 'fromscale' } = cv ('ruledefaultnodefromscale') ;
190                        $nodeRules{ $nodeNr }{ 'toscale' } =  cv ('ruledefaultnodetoscale') ;
191
192                        while ( ( defined $line) and ( ! grep /^rule/i, $line) ) {
193                                my ($k, $v) = ( $line =~ /(.+?)=(.+)/ ) ;
194                                if ( ( ! defined $k ) or ( ! defined $v ) ) {
195                                        print "WARNING: could not parse rule line: $line" ;
196                                }
197                                else {
198                                        $k = lc ( $k ) ;
199                                        $nodeRules{ $nodeNr }{ $k } = $v ;
200                                        if ( ! defined $vnp{$k} ) { print "WARNING: $k is not a valid node property!\n" ; }
201                                }
202                                $line = <$file> ;
203                        }
204                        if ( ! defined $nodeRules{ $nodeNr }{ 'keyvalue' } ) { die "ERROR: rule without keyValue detected!\n" ; }
205
206                } # node
207
208                elsif ( grep /^rule way/i, $line ) {
209
210                        $wayNr++ ;
211                        $wrr++ ;
212                        $line = <$file> ;
213
214                        # set defaults first
215                        $wayRules{ $wayNr }{ 'label' } = cv( 'ruleDefaultWayLabel' ) ;
216                        $wayRules{ $wayNr }{ 'labelsize' } = cv( 'ruleDefaultWayLabelSize' ) ;
217                        $wayRules{ $wayNr }{ 'labelcolor' } = cv( 'ruleDefaultWayLabelColor' ) ;
218                        $wayRules{ $wayNr }{ 'labelfont' } = cv( 'ruleDefaultWayLabelFont' ) ;
219                        $wayRules{ $wayNr }{ 'labeloffset' } = cv( 'ruleDefaultWayLabelOffset' ) ;
220                        $wayRules{ $wayNr }{ 'color' } = cv( 'ruleDefaultWayColor' ) ;
221                        $wayRules{ $wayNr }{ 'size' } = cv( 'ruleDefaultWaySize' ) ;
222                        $wayRules{ $wayNr }{ 'bordercolor' } = cv( 'ruleDefaultWayBorderColor' ) ;
223                        $wayRules{ $wayNr }{ 'bordersize' } = cv( 'ruleDefaultWayBorderSize' ) ;
224
225                        $wayRules{ $wayNr }{ 'svgstringtop' } = "" ;
226                        $wayRules{ $wayNr }{ 'svgstringbottom' } = "" ;
227
228                        $wayRules{ $wayNr }{ 'fromscale' } = cv ('ruledefaultwayfromscale') ;
229                        $wayRules{ $wayNr }{ 'toscale' } =  cv ('ruledefaultwaytoscale') ;
230
231                        while ( ( defined $line) and ( ! grep /^rule/i, $line) ) {
232                                my ($k, $v) = ( $line =~ /(.+?)=(.+)/ ) ;
233                                if ( ( ! defined $k ) or ( ! defined $v ) ) {
234                                        print "WARNING: could not parse rule line: $line" ;
235                                }
236                                else {
237                                        $k = lc ( $k ) ;
238                                        $wayRules{ $wayNr }{ $k } = $v ;
239                                        if ( ! defined $vwp{$k} ) { print "WARNING: $k is not a valid way property!\n" ; }
240                                }
241                                $line = <$file> ;
242                        }
243                        if ( ! defined $wayRules{ $wayNr }{ 'keyvalue' } ) { die "ERROR: rule without keyValue detected!\n" ; }
244
245                } # way
246
247                elsif ( grep /^rule area/i, $line ) {
248                        $areaNr++ ;
249                        $arr++ ;
250                        $line = <$file> ;
251
252                        # set defaults first
253                        $areaRules{ $areaNr }{ 'color' } = cv( 'ruleDefaultAreaColor' ) ;
254                        $areaRules{ $areaNr }{ 'icon' } = "none" ;
255                        $areaRules{ $areaNr }{ 'base' } = "no"  ;
256                        $areaRules{ $areaNr }{ 'svgstring' } = ""  ;
257                        $areaRules{ $areaNr }{ 'minsize' } = cv ('ruledefaultareaminsize')  ;
258                        $areaRules{ $areaNr }{ 'fromscale' } = cv ('ruledefaultareafromscale') ;
259                        $areaRules{ $areaNr }{ 'toscale' } =  cv ('ruledefaultareatoscale') ;
260
261                        while ( ( defined $line) and ( ! grep /^rule/i, $line) ) {
262                                my ($k, $v) = ( $line =~ /(.+?)=(.+)/ ) ;
263                                if ( ( ! defined $k ) or ( ! defined $v ) ) {
264                                        print "WARNING: could not parse rule line: $line" ;
265                                }
266                                else {
267                                        $k = lc ( $k ) ;
268                                        $areaRules{ $areaNr }{ $k } = $v ;
269                                        if ( ! defined $vap{$k} ) { print "WARNING: $k is not a valid area property!\n" ; }
270                                }
271                                $line = <$file> ;
272                        }
273                        if ( ! defined $areaRules{ $areaNr }{ 'keyvalue' } ) { die "ERROR: rule without keyValue detected!\n" ; }
274
275                } # area
276
277                elsif ( grep /^rule config/i, $line ) {
278                } # area
279
280                else {
281                        $line = <$file> ;
282                }
283
284        }
285
286
287        close ($file) ;
288
289        print "rules read: $nrr nodes, $wrr ways, $arr areas, $rrr routes and $crr configs\n\n" ;
290
291}
292
293sub getNodeRule {
294
295        # takes tagref and returns hashref to rule properties
296
297        my $tagRef = shift ;
298
299        my $scale = getScale() ;
300        if ( cv('rulescaleset') != 0 ) { $scale = cv('rulescaleset') ; }
301        # print "GNR: scale: $scale\n" ;
302
303        my $ruleFound ; undef $ruleFound ;
304
305        # print "\n" ;
306
307        RUL2: foreach my $rule (keys %nodeRules) {
308                # print "rule $rule\n" ;
309                if ( ( $nodeRules{$rule}{'fromscale'} <= $scale) and ( $nodeRules{$rule}{'toscale'} >= $scale) ) {
310
311                        my @kvs = split /;/, $nodeRules{$rule}{'keyvalue'} ;
312                        my $allValid = 1 ;
313                        RUL1: foreach my $kv1 ( @kvs ) { # for each needed
314                                my ($k, $v) = ( $kv1 =~ /(.+)=(.+)/ ) ;
315                                # print "  looking for $k=$v\n" ;
316                                my $found = 0 ;
317                                RUL3: foreach my $tag ( @$tagRef) {
318                                        # print "    actual kvs: $tag->[0]=$tag->[1]\n" ;
319                                        if ( ( $tag->[0] eq $k) and ( ( $tag->[1] eq $v) or ( $v eq "*") ) ) {
320                                                $found = 1 ;
321                                                # print "    FOUND\n" ;
322                                                last RUL3 ;
323                                        }
324                                } # tags
325                                if ( ! $found ) { 
326                                        $allValid = 0 ;
327                                        last RUL1 ; 
328                                }
329                        } # kv1
330
331                        if ( $allValid ) {
332                                # print "ALL VALID\n" ;
333                                # return the first rule found
334                                $ruleFound = \%{ $nodeRules{ $rule } } ;
335                                last RUL2 ;
336                        }
337
338                } # scale
339
340        } # all rules
341
342        return ($ruleFound) ;
343
344}
345
346sub printNodeRules {
347        foreach my $n (sort keys %nodeRules) {
348                print "node rule $n\n" ;
349                foreach my $v (sort keys %{$nodeRules{$n}}) {
350                        print "  $v=$nodeRules{$n}{$v}\n" ;
351                } 
352                print "\n" ;
353        }
354}
355
356# ---------------------------------------------------------------------------------------
357
358
359
360sub getWayRule {
361
362        # takes tagref and returns hashref to rule properties
363
364        my $tagRef = shift ;
365
366        my $scale = getScale() ;
367        if ( cv('rulescaleset') != 0 ) { $scale = cv('rulescaleset') ; }
368
369        my $ruleFound ; undef $ruleFound ;
370
371        RUL5: foreach my $rule (keys %wayRules) {
372                # print "rule $rule\n" ;
373                if ( ( $wayRules{$rule}{'fromscale'} <= $scale) and ( $wayRules{$rule}{'toscale'} >= $scale) ) {
374
375                        my @kvs = split /;/, $wayRules{$rule}{'keyvalue'} ;
376                        my $allValid = 1 ;
377                        RUL4: foreach my $kv1 ( @kvs ) { # for each needed
378                                my ($k, $v) = ( $kv1 =~ /(.+)=(.+)/ ) ;
379                                # print "  looking for $k=$v\n" ;
380                                my $found = 0 ;
381                                RUL6: foreach my $tag ( @$tagRef) {
382                                        # print "    actual kvs: $tag->[0]=$tag->[1]\n" ;
383                                        if ( ( $tag->[0] eq $k) and ( ( $tag->[1] eq $v) or ( $v eq "*") ) ) {
384                                                $found = 1 ;
385                                                # print "    FOUND\n" ;
386                                                last RUL6 ;
387                                        }
388                                } # tags
389                                if ( ! $found ) { 
390                                        $allValid = 0 ;
391                                        last RUL4 ; 
392                                }
393                        } # kv1
394
395                        if ( $allValid ) {
396                                # print "ALL VALID\n" ;
397                                # return the first rule found
398                                $ruleFound = \%{ $wayRules{ $rule } } ;
399                                last RUL5 ;
400                        }
401
402                } # scale
403
404        } # all rules
405
406        return ($ruleFound) ;
407
408}
409
410
411sub printWayRules {
412        foreach my $n (sort keys %wayRules) {
413                print "way rule $n\n" ;
414                foreach my $v (sort keys %{$wayRules{$n}}) {
415                        print "  $v=$wayRules{$n}{$v}\n" ;
416                } 
417                print "\n" ;
418        }
419}
420
421
422# ---------------------------------------------------------------------------------------
423
424
425
426sub getAreaRule {
427
428        # takes tagref and returns hashref to rule properties
429
430        my $tagRef = shift ;
431
432        my $scale = getScale() ;
433        if ( cv('rulescaleset') != 0 ) { $scale = cv('rulescaleset') ; }
434
435        my $ruleFound ; undef $ruleFound ;
436
437        RUL8: foreach my $rule (keys %areaRules) {
438                # print "rule $rule\n" ;
439                if ( ( $areaRules{$rule}{'fromscale'} <= $scale) and ( $areaRules{$rule}{'toscale'} >= $scale) ) {
440
441                        my @kvs = split /;/, $areaRules{$rule}{'keyvalue'} ;
442                        my $allValid = 1 ;
443                        RUL7: foreach my $kv1 ( @kvs ) { # for each needed
444                                my ($k, $v) = ( $kv1 =~ /(.+)=(.+)/ ) ;
445                                # print "  looking for $k=$v\n" ;
446                                my $found = 0 ;
447                                RUL9: foreach my $tag ( @$tagRef) {
448                                        # print "    actual kvs: $tag->[0]=$tag->[1]\n" ;
449                                        if ( ( $tag->[0] eq $k) and ( ( $tag->[1] eq $v) or ( $v eq "*") ) ) {
450                                                $found = 1 ;
451                                                # print "    FOUND\n" ;
452                                                last RUL9 ;
453                                        }
454                                } # tags
455                                if ( ! $found ) { 
456                                        $allValid = 0 ;
457                                        last RUL7 ; 
458                                }
459                        } # kv1
460
461                        if ( $allValid ) {
462                                # print "ALL VALID\n" ;
463                                # return the first rule found
464                                $ruleFound = \%{ $areaRules{ $rule } } ;
465                                last RUL8 ;
466                        }
467
468                } # scale
469
470        } # all rules
471
472        return ($ruleFound) ;
473
474}
475
476
477sub printAreaRules {
478        foreach my $n (sort keys %areaRules) {
479                print "area rule $n\n" ;
480                foreach my $v (sort keys %{$areaRules{$n}}) {
481                        print "  $v=$areaRules{$n}{$v}\n" ;
482                } 
483                print "\n" ;
484        }
485}
486
487
488
489
4901 ;
491
492
493
494
495
496
Note: See TracBrowser for help on using the repository browser.