Task: Sutherland-Hodgman polygon clipping






PHP: <?php
function clip ($subjectPolygon, $clipPolygon) {

    function inside ($p, $cp1, $cp2) {
        return ($cp2[0]-$cp1[0])*($p[1]-$cp1[1]) > ($cp2[1]-$cp1[1])*($p[0]-$cp1[0]);
    }
    
    function intersection ($cp1, $cp2, $e, $s) {
        $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 = end($clipPolygon);
    foreach ($clipPolygon as $cp2) {
        $inputList = $outputList;
        $outputList = [];
        $s = end($inputList);
        foreach ($inputList as $e) {
            if (inside($e, $cp1, $cp2)) {
                if (!inside($s, $cp1, $cp2)) {
                    $outputList[] = intersection($cp1, $cp2, $e, $s);
                }
                $outputList[] = $e;
            }
            else if (inside($s, $cp1, $cp2)) {
                $outputList[] = intersection($cp1, $cp2, $e, $s);
            }
            $s = $e;
        }
        $cp1 = $cp2;
    }
    return $outputList;
}

$subjectPolygon = [[50, 150], [200, 50], [350, 150], [350, 300], [250, 300], [200, 250], [150, 350], [100, 250], [100, 200]];
$clipPolygon = [[100, 100], [300, 100], [300, 300], [100, 300]];
$clippedPolygon = clip($subjectPolygon, $clipPolygon);

echo json_encode($clippedPolygon);
echo "\n";
?>





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