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]