Raster operations on the canvas

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