Пересечение двух Многоугольников

Пересечение двух Многоугольников

Первый Многоугольник
Второй Многоугольник
Результат пересечения

# Загружаем геометрическую библиотеку
package require math::geometry

proc PolygonIntersectPolygon { polygon1 polygon2 } {
  set res ""
  set isp1inside 0
  set isp2inside 0
  set isintersect 0

  # определяем какие точки первого многоугольника находятся внутри второго
  set lp1 ""
  foreach { x y } $polygon1 {
    if { [::math::geometry::pointInsidePolygon [list $x $y] $polygon2] } {
      lappend lp1 [list $x $y 1]
      set isp1inside 1
    } else {
      lappend lp1 [list $x $y 0]
    }
  }
  
  # определяем какие точки второго многоугольника находятся внутри первого
  set lp2 ""
  foreach { x y } $polygon2 {
    if { [::math::geometry::pointInsidePolygon [list $x $y] $polygon1] } {
      lappend lp2 [list $x $y 1]
      set isp2inside 1
    } else {
      lappend lp2 [list $x $y 0]
    }
  }
  
  if { $isp1inside && $isp2inside } { set isintersect 1 }
  
  # ищем точки пересечения сегментов и дополняем ими первый многоугольник
  set newlp1 ""
  foreach e1lp1 $lp1 e2lp1 [lrange $lp1 1 end] {
    lassign $e2lp1 1x2 1y2
    if { $1x2 eq "" } break
    lassign $e1lp1 1x1 1y1
    
    lappend newlp1 $e1lp1
    
    foreach e1lp2 $lp2 e2lp2 [lrange $lp2 1 end] {
      lassign $e2lp2 2x2 2y2
      if { $2x2 eq "" } break
      lassign $e1lp2 2x1 2y1
      lassign [::math::geometry::findLineSegmentIntersection [list $1x1 $1y1 $1x2 $1y2] [list $2x1 $2y1 $2x2 $2y2]] x y
      if { $x ne "" && $y ne "" } {
        lappend newlp1 [list $x $y 2]
      }
    }
  }
  
  # ищем точки пересечения сегментов и дополняем ими второй многоугольник
  set newlp2 ""
  foreach e1lp1 $lp2 e2lp1 [lrange $lp2 1 end] {
    lassign $e2lp1 1x2 1y2
    if { $1x2 eq "" } break
    lassign $e1lp1 1x1 1y1
    
    lappend newlp2 $e1lp1
    
    foreach e1lp2 $lp1 e2lp2 [lrange $lp1 1 end] {
      lassign $e2lp2 2x2 2y2
      if { $2x2 eq "" } break
      lassign $e1lp2 2x1 2y1
      lassign [::math::geometry::findLineSegmentIntersection [list $1x1 $1y1 $1x2 $1y2] [list $2x1 $2y1 $2x2 $2y2]] x y
      if { $x ne "" && $y ne "" } {
        lappend newlp2 [list $x $y 2]
      }
    }
  }
  set lp1 $newlp1
  set lp2 $newlp2

  # проходим по второму списку и добавляем внутренние точки второго списка в первый список
  set segment ""
  foreach el $lp2 {
    lassign $el x y s
    if { $s == 2 } {
      if { [llength $segment] > 0 } {
        set idx [lsearch $lp1 $el]
        if { $idx > -1 } {
          set lp1 [eval linsert {$lp1} $idx $segment]
          set segment ""
        }
      }
    }
    if { $s == 1 } {
      lappend segment $el
    }
  }
  # и обратный проход, но до первой точки пересечения
  if { $isintersect && [llength $segment] > 0 } {
    foreach el [lreverse $lp2] {
      lassign $el x y s
      if { $s == 2 } {
        set idx [lindex [lsearch -all $lp1 $el] end]
        if { $idx > -1 } {
          incr idx
          set lp1 [eval linsert {$lp1} $idx $segment]
        }
        break
      }
    }
  }

  # формирование результирующего многоугольника
  if { $isintersect } {
    # существует пересечение
    foreach el $lp1 {
      lassign $el x y s
      if { $s == 0 } continue
      lappend res $x $y
    }
  } elseif { $isp1inside } {
    # первый многоугольник полностью во втором
    set res $polygon1
  } elseif { $isp2inside } {
    # второй многоугольник полностью в первом
    set res $polygon2
  }
  
  return $res
}