[Richard Suchenwirth] 2004-07-22 - Given the coordinates of two convex polygons (in the same meaning as [canvas] items), I wanted to determine the coordinates of the polygon where the two overlap. You can interpret this also as the intersection, if the two polygons represent sets of points inside them.

The idea was: The overlap polygon is bounded by the [convex hull] of those points where
   * a side of one polygon crosses a side of the other, or
   * a corner of one polygon is enclosed in the other
Enclosure of a point in a polygon was tested by checking whether the line between the point and another that is known to be inside the polygon (namely, its center :) crosses no boundaries of the polygon. So both criteria could be simplified down to checking whether, and if so, where, two lines cross.

And here's the code (make sure the functions ''ccw'' and ''hull2d'' from [Convex hull] are also available):
----
 namespace eval polygon {}

 proc polygon::overlap {p1 p2} {
    set res {}
    set lines2 [sides $p2]
    #-- collect crossing points
    foreach a [sides $p1] {
	foreach b $lines2 {
	    set point [lines'cross $a $b]
	    if {$point ne ""} {lappend res $point}
	}
    }
    #-- collects points of one polygon enclosed in the other
    foreach a [corners $p1] {
	if [enclosed $p2 $a] {lappend res $a}
    }
    foreach a [corners $p2] {
	if [enclosed $p1 $a] {lappend res $a}
    }
    join [hull2d $res]
 }

 proc polygon::center coords {
    # returns the x y coordinates of the center
    set xsum 0.0
    set ysum 0.0
    set n    0
    foreach {x y} $coords {
	+= xsum $x
	+= ysum $y
	incr n
    }
    list [expr {$xsum/$n}] [expr {$ysum/$n}]
 }
 proc polygon::enclosed {coords point} {
    set testline [concat $point [center $coords]]
    foreach side [sides $coords] {
	if {[lines'cross $side $testline] ne ""} {return 0}
    }
    return 1
 }
 proc polygon::sides coords {
    foreach {x0 y0} $coords break
    set res {}
    foreach {x y} [lrange $coords 2 end] {
	lappend res [list $x0 $y0 $x $y]
	set x0 $x
	set y0 $y
    }
    lappend res [list $x $y [lindex $coords 0] [lindex $coords 1]]
 }
 proc polygon::corners coords {
    set res {}
    foreach {x y} $coords {
	lappend res [list $x $y]
    }
    set res
 }
# This took me most thinking - find out whether (and where) two lines cross
 proc lines'cross {line1 line2} {
    #-- return crossing point of 2 line segments, or {} if not crossing
    foreach {xa ya xb yb} $line1 break
    foreach {xc yc xd yd} $line2 break
    if {$xa == $xb} {
	if {$xc == $xd} return ;# parallels
	set n [expr {($yd-$yc)/double($xd-$xc)}]
	set b [expr {$yc - $n*$xc}]
	set x $xa
	set y [expr {$n*$x + $b}]
    } else {
	set m [expr {($yb-$ya)/double($xb-$xa)}]
	set a [expr {$ya - $m*$xa}]
	if {$xc == $xd} {
	    set x $xc
	} else {
	    set n [expr {($yd-$yc)/double($xd-$xc)}]
	    if {$m == $n} return ;# parallels
	    set b [expr {$yc - $n*$xc}]
	    set x [expr {($b-$a)/($m-$n)}]
	}
	set y [expr {$m*$x + $a}]
    }
    if {$x < [min $xa $xb] || $x > [max $xa $xb]
	|| $x < [min $xc $xd] || $x > [max $xc $xd]
    } return
    if {$y < [min $ya $yb] || $y > [max $ya $yb]
	|| $y < [min $yc $yd] || $y > [max $yc $yd]
    } return
    return [list $x $y]
 }
 proc min {a b} {expr {$a < $b? $a : $b}}
 proc max {a b} {expr {$a > $b? $a : $b}}

 proc += {varName amount} {
    upvar 1 $varName var
    set var [expr {$var+$amount}]
 }

----
[Arts and crafts of Tcl-Tk programming]