Arjen Markus (13 september 2004) A recent discussion on the comp.lang.tcl newsgroup which arose after a question of mine :), raised the issue of vector versus raster operations in geographical information systems.
While I have not found the time yet to explore this in any detail, I have found out that Tk's
canvas can serve you well if you have a need to do this kind of computations. Let me explain the idea:
- Quite often an analysis of geographic data involves finding out the (weighted) area of overlap between two polygons. Just an example: you have a projected highway which produces a lot of noise - how large is the region of houses that suffer too much noise?
- Doing these computations on rasterised polygons (that is: polygons that are replaced by rectangles or squares) is much easier than using the vector representation (that is, the set of coordinates of all the vertices of the polygons).
- Tk's canvas is excellent in displaying complicated polygons. It also provides query functions like 'find overlapping".
So, the script below tries to estimate the overlap of two rectangles.
Special notes:
- The canvas is not visible
- The rectangles fall partly outside the canvas's area
- The rectangles are filled, because otherwise the "find overlapping" function considers them lines, rather than filled areas ...
- A more elaborate scheme would go into pixels once a square was found that holds both rectangles
# det_area.tcl --
# Determine the area of overlap
#
package require Tk
catch {
console show
}
#
# Create a canvas without showing it
# Create two overlapping items
#
canvas .c -width 100 -height 100 -bg white
#
# It matters whether the items are filled or not
# for the find operation
#
.c create rectangle -100 -100 20 20 -fill green
.c create rectangle -10 -10 40 40 -fill red
proc calcArea {} {
set area 0
for { set j -10 } { $j < 4 } { incr j } {
for { set i -10 } { $i < 4 } { incr i } {
set x1 [expr {$i*10}]
set x2 [expr {$x1+9}]
set y1 [expr {$j*10}]
set y2 [expr {$y1+9}]
set items [.c find overlapping $x1 $y1 $x2 $y2]
# if { [llength $items] != 0 } {
# puts "Rectangle: $x1 $y1 $x2 $y2 - $items"
# }
if { [llength $items] == 2 } {
puts "Rectangle: $x1 $y1 $x2 $y2"
incr area 1
}
}
}
return $area
}
puts [calcArea]
Screenshots Section
gold added pix
