source: subversion/applications/utils/gary68/mwOccupy.pm @ 34714

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

mapweaver: new place management for labels and icons

File size: 7.1 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 mwOccupy ; 
20
21use strict ;
22use warnings ;
23
24use List::Util qw[min max] ;
25
26use mwMap ;
27
28use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
29
30require Exporter ;
31
32@ISA = qw ( Exporter AutoLoader ) ;
33
34@EXPORT = qw (  boxOccupyLines
35                boxOccupyArea
36                boxLinesOccupied
37                boxAreaOccupied
38                boxDrawOccupiedAreas
39                 ) ;
40
41
42my $boxSize = 5 ;
43
44my %box = () ;
45
46
47# -------------------------------------------------------------
48
49sub boxOccupyLines {
50        my ($refCoords, $buffer, $value) = @_ ;
51        my @coordinates = @$refCoords ;
52        my @lines = () ;
53
54        for ( my $i = 0; $i < $#coordinates-2; $i += 2 ) {
55                push @lines, [$coordinates[$i], $coordinates[$i+1], $coordinates[$i+2], $coordinates[$i+3]] ;
56        }
57
58        foreach my $line ( @lines ) {
59                my $x1 = $line->[0] ;
60                my $y1 = $line->[1] ;
61                my $x2 = $line->[2] ;
62                my $y2 = $line->[3] ;
63
64
65                # print "$x1, $y1, $x2, $y2\n" ;
66
67                if ( $x1 != $x2) {
68
69                        my $m = ($y2 - $y1) / ($x2 - $x1) ;
70                        my $b = $y1 - $m * $x1 ;
71
72                        if ( abs ( $x1 - $x2 ) > abs ( $y1 - $y2 ) ) {
73
74                                # calc points on x axis
75                                my $x = $x1 ;
76                                my $stepX = $boxSize ;
77                                if ( $x2 < $x1 ) { $stepX = - $boxSize ; }
78                                while ( ( $x >= min ($x1, $x2) ) and ( $x <= max ($x1, $x2) ) ) {
79
80                                        my $y = $m * $x + $b ;
81
82                                        # ACTUAL COORDINATE $x, $y
83                                        my $ax1 = $x - $buffer ;
84                                        my $ax2 = $x + $buffer ;
85                                        my $ay1 = $y - $buffer ;
86                                        my $ay2 = $y + $buffer ;
87                                        boxOccupyArea ($ax1, $ay1, $ax2, $ay2, 0, $value) ;
88                                        $x += $stepX ; 
89                                }
90
91                        }
92                        else {         
93
94                                # calc points on y axis
95                                my $y = $y1 ;
96                                my $stepY = $boxSize ;
97                                if ( $y2 < $y1 ) { $stepY = - $boxSize ; }
98                                while ( ( $y >= min ($y1, $y2) ) and ( $y <= max ($y1, $y2) ) ) {
99
100                                        my $x = ($y - $b) / $m ;
101
102                                        # ACTUAL COORDINATE $x, $y
103                                        my $ax1 = $x - $buffer ;
104                                        my $ax2 = $x + $buffer ;
105                                        my $ay1 = $y - $buffer ;
106                                        my $ay2 = $y + $buffer ;
107                                        boxOccupyArea ($ax1, $ay1, $ax2, $ay2, 0, $value) ;
108
109                                        $y += $stepY ; 
110                                }
111
112                        } # abs
113
114                }
115                else {
116                        my $x = $x1 ;
117
118                        # calc points on y axis
119                        my $y = $y1 ;
120                        my $stepY = $boxSize ;
121                        if ( $y2 < $y1 ) { $stepY = - $boxSize ; }
122                        while ( ( $y >= min ($y1, $y2) ) and ( $y <= max ($y1, $y2) ) ) {
123
124                                # ACTUAL COORDINATE $x, $y
125                                my $ax1 = $x - $buffer ;
126                                my $ax2 = $x + $buffer ;
127                                my $ay1 = $y - $buffer ;
128                                my $ay2 = $y + $buffer ;
129                                boxOccupyArea ($ax1, $ay1, $ax2, $ay2, 0, $value) ;
130
131                                $y += $stepY ; 
132                        }
133                }       
134
135        }
136}
137
138
139sub boxLinesOccupied {
140        my ($refCoords, $buffer) = @_ ;
141        my @coordinates = @$refCoords ;
142        my @lines = () ;
143        my $result = 0 ;
144
145        for ( my $i = 0; $i < $#coordinates-2; $i += 2 ) {
146                push @lines, [$coordinates[$i], $coordinates[$i+1], $coordinates[$i+2], $coordinates[$i+3]] ;
147        }
148
149        foreach my $line ( @lines ) {
150                my $x1 = $line->[0] ;
151                my $y1 = $line->[1] ;
152                my $x2 = $line->[2] ;
153                my $y2 = $line->[3] ;
154
155
156                # print "$x1, $y1, $x2, $y2\n" ;
157
158                if ( $x1 != $x2) {
159
160                        my $m = ($y2 - $y1) / ($x2 - $x1) ;
161                        my $b = $y1 - $m * $x1 ;
162
163                        if ( abs ( $x1 - $x2 ) > abs ( $y1 - $y2 ) ) {
164
165                                # calc points on x axis
166                                my $x = $x1 ;
167                                my $stepX = $boxSize ;
168                                if ( $x2 < $x1 ) { $stepX = - $boxSize ; }
169                                while ( ( $x >= min ($x1, $x2) ) and ( $x <= max ($x1, $x2) ) ) {
170
171                                        my $y = $m * $x + $b ;
172
173                                        # ACTUAL COORDINATE $x, $y
174                                        my $ax1 = $x - $buffer ;
175                                        my $ax2 = $x + $buffer ;
176                                        my $ay1 = $y - $buffer ;
177                                        my $ay2 = $y + $buffer ;
178                                        my $tmp = boxAreaOccupied ($ax1, $ay1, $ax2, $ay2) ;
179                                        if ($tmp > $result) { $result = $tmp ; }
180                                        $x += $stepX ; 
181                                }
182
183                        }
184                        else {         
185
186                                # calc points on y axis
187                                my $y = $y1 ;
188                                my $stepY = $boxSize ;
189                                if ( $y2 < $y1 ) { $stepY = - $boxSize ; }
190                                while ( ( $y >= min ($y1, $y2) ) and ( $y <= max ($y1, $y2) ) ) {
191
192                                        my $x = ($y - $b) / $m ;
193
194                                        # ACTUAL COORDINATE $x, $y
195                                        my $ax1 = $x - $buffer ;
196                                        my $ax2 = $x + $buffer ;
197                                        my $ay1 = $y - $buffer ;
198                                        my $ay2 = $y + $buffer ;
199                                        my $tmp = boxAreaOccupied ($ax1, $ay1, $ax2, $ay2) ;
200                                        if ($tmp > $result) { $result = $tmp ; }
201
202                                        $y += $stepY ; 
203                                }
204
205                        } # abs
206
207                }
208                else {
209                        my $x = $x1 ;
210
211                        # calc points on y axis
212                        my $y = $y1 ;
213                        my $stepY = $boxSize ;
214                        if ( $y2 < $y1 ) { $stepY = - $boxSize ; }
215                        while ( ( $y >= min ($y1, $y2) ) and ( $y <= max ($y1, $y2) ) ) {
216
217                                # ACTUAL COORDINATE $x, $y
218                                my $ax1 = $x - $buffer ;
219                                my $ax2 = $x + $buffer ;
220                                my $ay1 = $y - $buffer ;
221                                my $ay2 = $y + $buffer ;
222                                my $tmp = boxAreaOccupied ($ax1, $ay1, $ax2, $ay2) ;
223                                if ($tmp > $result) { $result = $tmp ; }
224
225                                $y += $stepY ; 
226                        }
227                }       
228
229        }
230        return $result ; 
231}
232
233
234# -------------------------------------------------------------
235
236sub boxOccupyArea {
237        my ($x1, $y1, $x2, $y2, $buffer, $value) = @_ ;
238
239        if ( $x2 < $x1) {
240                my $tmp = $x1 ;
241                $x1 = $x2 ;
242                $x2 = $tmp ;
243        }
244        if ( $y2 < $y1) {
245                my $tmp = $y1 ;
246                $y1 = $y2 ;
247                $y2 = $tmp ;
248        }
249
250        $x1 -= $buffer ;
251        $x2 += $buffer ;
252        $y1 -= $buffer ;
253        $y2 += $buffer ;
254
255        for ( my $x = $x1; $x <= $x2; $x += $boxSize) {
256                for ( my $y = $y1; $y <= $y2; $y += $boxSize) {
257                        my $bx = int ( $x / $boxSize ) ;
258                        my $by = int ( $y / $boxSize ) ;
259                        $box{$bx}{$by} = $value ;
260                        # print "box $bx, $by occupied\n" ;
261                }
262        }
263
264        return ;
265}
266
267
268sub boxAreaOccupied {
269        my ($x1, $y1, $x2, $y2) = @_ ;
270        my $result = 0 ;
271
272        if ( $x2 < $x1) {
273                my $tmp = $x1 ;
274                $x1 = $x2 ;
275                $x2 = $tmp ;
276        }
277        if ( $y2 < $y1) {
278                my $tmp = $y1 ;
279                $y1 = $y2 ;
280                $y2 = $tmp ;
281        }
282
283        for ( my $x = $x1; $x <= $x2; $x += $boxSize) {
284                my $bx = int ($x / $boxSize) ;
285                for ( my $y = $y1; $y <= $y2; $y += $boxSize) {
286                        my $by = int ($y / $boxSize) ;
287                        # print "  $bx, $by\n" ;
288                        if ( defined $box{$bx}{$by} ) {
289                                if ( $box{$bx}{$by} > $result ) {
290                                        # print "check box $bx, $by\n" ;
291                                        $result = $box{$bx}{$by} ;
292                                }
293                        }
294                }
295        }
296        return $result ;
297}
298
299
300# -------------------------------------------------------------
301
302
303sub boxDrawOccupiedAreas {
304        my $format1 = "fill=\"red\" fill-opacity=\"0.3\" " ;
305        my $format2 = "fill=\"blue\" fill-opacity=\"0.3\" " ;
306        my $format3 = "fill=\"green\" fill-opacity=\"0.5\" " ;
307        foreach my $bx ( sort {$a <=> $b} keys %box ) {
308                foreach my $by ( sort {$a <=> $b} keys %{$box{$bx}} ) {
309                        my $x1 = $bx * $boxSize ;
310                        my $x2 = $x1 + $boxSize ;
311                        my $y1 = $by * $boxSize ;
312                        my $y2 = $y1 + $boxSize ;
313
314                        if ( $box{$bx}{$by} == 1) {
315                                drawRect ($x1, $y1, $x2, $y2, 0, $format1, "occupied") ;
316                        }
317                        elsif ( $box{$bx}{$by} == 2) {
318                                drawRect ($x1, $y1, $x2, $y2, 0, $format2, "occupied") ;
319                        }
320                        else  {
321                                drawRect ($x1, $y1, $x2, $y2, 0, $format3, "occupied") ;
322                        }
323                        # print "occupied $bx, $by\n" ;
324                }
325        }
326
327}
328
329
3301 ;
331
332
Note: See TracBrowser for help on using the repository browser.