Task: Sutherland-Hodgman polygon clipping







Python: def clip(subjectPolygon, clipPolygon):
   def inside(p):
      return(cp2[0]-cp1[0])*(p[1]-cp1[1]) > (cp2[1]-cp1[1])*(p[0]-cp1[0])
      
   def computeIntersection():
      dc = [ cp1[0] - cp2[0], cp1[1] - cp2[1] ]
      dp = [ s[0] - e[0], s[1] - e[1] ]
      n1 = cp1[0] * cp2[1] - cp1[1] * cp2[0]
      n2 = s[0] * e[1] - s[1] * e[0] 
      n3 = 1.0 / (dc[0] * dp[1] - dc[1] * dp[0])
      return [(n1*dp[0] - n2*dc[0]) * n3, (n1*dp[1] - n2*dc[1]) * n3]

   outputList = subjectPolygon
   cp1 = clipPolygon[-1]
   
   for clipVertex in clipPolygon:
      cp2 = clipVertex
      inputList = outputList
      outputList = []
      s = inputList[-1]

      for subjectVertex in inputList:
         e = subjectVertex
         if inside(e):
            if not inside(s):
               outputList.append(computeIntersection())
            outputList.append(e)
         elif inside(s):
            outputList.append(computeIntersection())
         s = e
      cp1 = cp2
   return(outputList)




Fortran: module SutherlandHodgmanUtil
  

  
  type polygon
    
    
    integer :: n
    double precision, dimension(:,:), allocatable :: vertex
  end type polygon
  
  contains 
  
  
  subroutine sutherlandHodgman( ref, clip, outputPolygon )
    
  
    
    type(polygon) :: ref, clip, outputPolygon
  
    
    type(polygon) :: workPolygon               
    double precision, dimension(2) :: y1,y2    
    integer :: i  
  
    
    
    allocate(workPolygon%vertex( ref%n+clip%n , 2 ))
    
    
    workPolygon%n = clip%n
    workPolygon%vertex(1:workPolygon%n,:) = clip%vertex(1:workPolygon%n,:)

    do i=1,ref%n-1 
      y1(:) = ref%vertex(i,:)   
      y2(:) = ref%vertex(i+1,:) 
  
      
      call edgeClipping( workPolygon, y1, y2, outputPolygon)
      
      workPolygon%n = outputPolygon%n
      workPolygon%vertex(1:workPolygon%n,:) = outputPolygon%vertex(1:workPolygon%n,:)

    end do 
    deallocate(workPolygon%vertex)
  end subroutine sutherlandHodgman
  
  
  subroutine edgeClipping( poly, y1, y2, outputPoly )
    
    
    type(polygon) :: poly, outputPoly
    double precision, dimension(2) :: y1, y2, x1, x2, intersecPoint
    integer ::  i, c
    
    c = 0 
    
    do i=1,poly%n-1 
      x1(:) = poly%vertex(i,:)   
      x2(:) = poly%vertex(i+1,:) 
      
      if ( inside(x1, y1, y2) ) then 
        if ( inside(x2, y1, y2) ) then 
          
          c = c+1
          outputPoly%vertex(c,:) = x2(:)

        else 
          intersecPoint = intersection(x1, x2, y1,y2)
          c = c+1
          outputPoly%vertex(c,:) = intersecPoint(:)
        end if
      else 
        if ( inside(x2, y1, y2) ) then
          intersecPoint = intersection(x1, x2, y1,y2)
          c = c+1
          outputPoly%vertex(c,:) = intersecPoint(:)
          
          c = c+1
          outputPoly%vertex(c,:) = x2(:)
        end if
      end if
    end do
    
    if (c .gt. 0) then
      
      if ( (outputPoly%vertex(1,1) .ne. outputPoly%vertex(c,1)) .or. & 
           (outputPoly%vertex(1,2) .ne. outputPoly%vertex(c,2)))  then
        c=c+1
        outputPoly%vertex(c,:) = outputPoly%vertex(1,:)
      end if
    end if
    
    outputPoly%n = c
  end subroutine edgeClipping
  
  
  function intersection( x1, x2, y1, y2)
    
    

    
    double precision, dimension(2) :: x1, x2, &  
                                      y1, y2     
    
    double precision, dimension(2) :: intersection, vx, vy, x1y1 
    double precision :: a
  
    vx(:) = x2(:) - x1(:) 
    vy(:) = y2(:) - y1(:)

    
    if ( crossProduct(vx,vy) .eq. 0.d0) then
      x1y1(:) = y1(:) - x1(:)
      
      if ( crossProduct(x1y1,vx) .eq. 0.d0) then
        
        intersection(:) = x2(:)
      end if
    else 
      
      
      
      
      
      
      
      
     
      x1y1(:) = y1(:) - x1(:) 
      
      a = crossProduct(x1y1,vy)/crossProduct(vx,vy)
      
      if ( (a .gt. 1.d0) .or. (a .lt. 0)) then
        
      else
        intersection(:) = x1(:) + a*vx(:)
      end if
    end if

  end function intersection
  
  
  
  function inside( p, y1, y2)
    
    
    double precision, dimension(2) :: p, y1, y2, v1, v2
    logical :: inside
    v1(:) = y2(:) -  y1(:)
    v2(:) = p(:)  -  y1(:)  
    if ( crossProduct(v1,v2) .ge. 0.d0) then
      inside = .true.
    else 
      inside = .false.
    end if
   
   contains 
  end function inside

  
  function dotProduct( v1, v2)
    
    double precision, dimension(2) :: v1
    double precision, dimension(2) :: v2
    double precision :: dotProduct
    dotProduct = v1(1)*v2(1) + v1(2)*v2(2)
  end function dotProduct

  
  function crossProduct( v1, v2)
    
    double precision, dimension(2) :: v1
    double precision, dimension(2) :: v2
    double precision :: crossProduct
    crossProduct = v1(1)*v2(2) - v1(2)*v2(1)
  end function crossProduct

end module SutherlandHodgmanUtil

program main
  
  
  use SutherlandHodgmanUtil, only : polygon, &
                                    sutherlandHodgman, &
                                    edgeClipping

  type(polygon) :: p1, p2, res
  integer :: c, n 
  double precision, dimension(2) :: y1, y2
  
  

  
  p1%n = 10
  allocate(p1%vertex(p1%n,2))
  p1%vertex(1,1)=50.d0
  p1%vertex(1,2)=150.d0
  
  p1%vertex(2,1)=200.d0
  p1%vertex(2,2)=50.d0
  
  p1%vertex(3,1)= 350.d0
  p1%vertex(3,2)= 150.d0
  
  p1%vertex(4,1)= 350.d0
  p1%vertex(4,2)= 300.d0
  
  p1%vertex(5,1)= 250.d0
  p1%vertex(5,2)= 300.d0
  
  p1%vertex(6,1)= 200.d0
  p1%vertex(6,2)= 250.d0
  
  p1%vertex(7,1)= 150.d0
  p1%vertex(7,2)= 350.d0
  
  p1%vertex(8,1)= 100.d0
  p1%vertex(8,2)= 250.d0
  
  p1%vertex(9,1)= 100.d0
  p1%vertex(9,2)= 200.d0
  
  p1%vertex(10,1)=  50.d0
  p1%vertex(10,2)= 150.d0
 
  y1 = (/ 100.d0, 300.d0 /)
  y2 = (/ 300.d0, 300.d0 /)
  
  
  p2%n = 5
  allocate(p2%vertex(p2%n,2))

  p2%vertex(1,1)= 100.d0
  p2%vertex(1,2)= 100.d0
  
  p2%vertex(2,1)= 300.d0
  p2%vertex(2,2)= 100.d0
  
  p2%vertex(3,1)= 300.d0
  p2%vertex(3,2)= 300.d0
  
  p2%vertex(4,1)= 100.d0
  p2%vertex(4,2)= 300.d0
  
  p2%vertex(5,1)= 100.d0
  p2%vertex(5,2)= 100.d0
 
  allocate(res%vertex(p1%n+p2%n,2))
  call sutherlandHodgman( p2, p1, res)
  write(*,*) "Suterland-Hodgman"
  do c=1, res%n
    write(*,*) res%vertex(c,1), res%vertex(c,2)
  end do
  deallocate(res%vertex)

end program main