[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}]
    }
    # added little epsilons for float comparison
    if {$x < [min $xa $xb]-.1 || $x > [max $xa $xb]+.1
	|| $x < [min $xc $xd]-.1 || $x > [max $xc $xd]+.1
    } return
    if {$y < [min $ya $yb]-.1 || $y > [max $ya $yb]+.1
	|| $y < [min $yc $yd]-.1 || $y > [max $yc $yd]+.1
    } 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}]
 }
----
[RS] 2004-08-05: because of [a real problem], had to add epsilons in the exclusion checks (happening when one line was exactly horizontal)
----
[KBK] 2004-08-06: Would recasting [[lines'cross]] as the following code help with your epsilons? 
It makes a fairly conventional parametrization (see the comments at the head of the code) that
allows finding the point of intersection by solving a system of linear equations.  The parameters
are chosen so that they will both lie in the interval [-1,1] if the line segments intersect;
this allows testing them before attempting any dangerous divisions.

 # Let the point of intersection of the two lines be (x,y)
 #   x = xa * (1-p) + xb * (1+p) = xc * (1-q) + xd * (1+q)
 #   y = ya * (1-p) + yb * (1+p) = yc * (1-q) + yd * (1+q)
 # The point of intersection lies within the first line segment
 # if and only if p<=1, and within the second line segment
 # if and only if q<=1.  We recast this into a 2x2 linear
 # system and solve.  We avoid dividing by the determinant
 # until we've determined that both intersections lie within
 # the lines in question
 
 proc lines'cross { line1 line2 } {
     foreach { xa ya xb yb } $line1 break
     foreach { xc yc xd yd } $line2 break
 
     set det [expr { ( $xb - $xa ) * ( $yd - $yc )
 		    - ( $xd - $xc ) * ( $yb - $ya ) }]
     if { $det == 0. } {                # line segments parallel or
                                        # collinear
         return {}
     }
     set nump [expr { ( $xd - $xc ) * ( $yb + $ya )
 		     - ( $xb + $xa ) * ( $yd - $yc )
 		     + 2. * ( $xc * $yd - $xd * $yc ) }]
     if { abs($nump) > abs($det) } {	# point of intersection is
 					# outside first line segment
 	return {}
     }
     set numq [expr { ( $xd + $xc ) * ( $yb - $ya )
 		     - ( $xb - $xa ) * ( $yd + $yc )
 		     - 2. * ( $xb * $ya - $xa * $yb ) }]
     if { abs($numq) > abs($det) } {	# point of intersction is
 					# outside second line segment
 	return {}
     }
     set p [expr { $nump / $det }]
     set opp [expr { 1. + $p }]
     set omp [expr { 1. - $p }]
     set x [expr { $xa * $omp + $xb * $opp }]
     set y [expr { $ya + $omp + $yb * $opp }]
     return [list $x $y]
 }


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