ezpolyclip.pas

很管用的GIS控件

Begin

  (* Label contour as external *)
  q.proxy.hole := FALSE;

  If p.proxy <> q.proxy Then
  Begin
    (* Assign p's vertex list to the right end of q's list *)
    q.proxy.v[RIGHT].next := p.proxy.v[LEFT];
    q.proxy.v[RIGHT] := p.proxy.v[RIGHT];

    (* Redirect any p.proxy references to q.proxy *)
    target := p.proxy;
    While list <> Nil Do
    Begin
      If list.proxy = target Then
      Begin
        list.active := Ord( FALSE );
        list.proxy := q.proxy;
      End;
      list := list.next;
    End;
  End;
End;

Procedure add_local_min( Var p: PPolygonNode; edge: PEdgeNode; Const x, y: double );
Var
  existing_min: PPolygonNode;
  nv: PVertexNode;
Begin

  existing_min := p;

  New( p );
  fillchar( p^, sizeof( TPolygonNode ), 0 );

  (* Create a new vertex node and set its fields *)
  New( nv );
  fillchar( nv^, sizeof( TVertexNode ), 0 );
  nv.x := x;
  nv.y := y;
  nv.next := Nil;

  (* Initialise proxy to point to p itself *)
  p.proxy := p;
  p.active := Ord( TRUE );
  p.next := existing_min;

  (* Make v[LEFT] and v[RIGHT] point to new vertex nv *)
  p.v[LEFT] := nv;
  p.v[RIGHT] := nv;

  (* Assign polygon p to the edge *)
  edge^.outp[ABOVE] := p;
End;

{$IFDEF FALSE}

Function count_tristrips( tn: PPolygonNode ): integer;
Begin
  result := 0;
  While tn <> Nil Do
  Begin
    If tn.active > 2 Then
      Inc( result );
    tn := tn.next;
  End;
End;

Procedure new_tristrip( Var tn: PPolygonNode; edge: PEdgeNode; Const x, y: double );
Begin
  If tn = Nil Then
  Begin
    New( tn );
    fillchar( tn^, sizeof( TPolygonNode ), 0 );
    tn.next := Nil;
    tn.v[LEFT] := Nil;
    tn.v[RIGHT] := Nil;
    tn.active := 1;
    add_vertex( tn.v[LEFT], x, y );
    edge.outp[ABOVE] := tn;
  End
  Else
    (* Head further down the list *)
    new_tristrip( tn.next, edge, x, y );
End;
{$ENDIF}

Function create_contour_bboxes( p: TEzClipPolygon ): PEzRectArray;
Var
  box: PEzRectArray;
  c, v: integer;
Begin

  GetMem( box, p.num_contours * sizeof( TEzRect ) );
  fillchar( box^, p.num_contours * sizeof( TEzRect ), 0 );

  (* Construct contour bounding boxes *)
  For c := 0 To p.num_contours - 1 Do
  Begin
    (* Initialise bounding box extent *)
    box[c].xmin := DBL_MAX;
    box[c].ymin := DBL_MAX;
    box[c].xmax := -DBL_MAX;
    box[c].ymax := -DBL_MAX;

    For v := 0 To p.contour[c].NumVertices - 1 Do
    Begin
      (* Adjust bounding box *)
      box[c].xmin := dmin( box[c].xmin, p.contour[c].vertex[v].x );
      box[c].ymin := dmin( box[c].ymin, p.contour[c].vertex[v].y );
      box[c].xmax := dmax( box[c].xmax, p.contour[c].vertex[v].x );
      box[c].ymax := dmax( box[c].ymax, p.contour[c].vertex[v].y );
    End;
  End;
  result := box;
End;

Procedure minimax_test( subj, clip: TEzClipPolygon; op: TEzPolyClipOp );
Var
  s_bbox, c_bbox: PEzRectArray;
  s, c, arrsize: integer;
  overlap: boolean;
  o_table: PBooleanArray;
  temp: TEzPointList;
Begin

  s_bbox := create_contour_bboxes( subj );
  c_bbox := create_contour_bboxes( clip );

  arrsize := subj.num_contours * clip.num_contours;
  GetMem( o_table, arrsize * sizeof( boolean ) );
  fillchar( o_table^, arrsize * sizeof( boolean ), 0 );

  (* Check all subject contour bounding boxes against clip boxes *)
  For s := 0 To subj.num_contours - 1 Do
    For c := 0 To clip.num_contours - 1 Do
      o_table[c * subj.num_contours + s] :=
        ( Not ( ( s_bbox[s].xmax < c_bbox[c].xmin ) Or
        ( s_bbox[s].xmin > c_bbox[c].xmax ) ) ) And
        ( Not ( ( s_bbox[s].ymax < c_bbox[c].ymin ) Or
        ( s_bbox[s].ymin > c_bbox[c].ymax ) ) );

  (* For each clip contour, search for any subject contour overlaps *)
  For c := 0 To clip.num_contours - 1 Do
  Begin
    overlap := false;
    s := 0;
    While ( Not overlap ) And ( s < subj.num_contours ) Do
    Begin
      overlap := o_table[c * subj.num_contours + s];
      Inc( s );
    End;

    If Not overlap Then
    Begin
      (* Flag non contributing status by negating vertex count *)
      temp := clip.contour[c];
      temp.NumVertices := -clip.contour[c].NumVertices;
      clip.contour[c] := temp;
    End;
  End;

  If op = pcINT Then
  Begin
    (* For each subject contour, search for any clip contour overlaps *)
    For s := 0 To subj.num_contours - 1 Do
    Begin
      overlap := false;
      c := 0;
      While ( Not overlap ) And ( c < clip.num_contours ) Do
      Begin
        overlap := o_table[c * subj.num_contours + s];
        Inc( c );
      End;
      If Not overlap Then
      Begin
        (* Flag non contributing status by negating vertex count *)
        temp := clip.contour[s];
        temp.NumVertices := -subj.contour[s].NumVertices;
        clip.contour[s] := temp;
      End;
    End;
  End;
  FreeMem( s_bbox, subj.num_contours * sizeof( TEzRect ) );
  FreeMem( c_bbox, clip.num_contours * sizeof( TEzRect ) );
  FreeMem( o_table, arrsize * sizeof( boolean ) );
End;

Procedure freeheap( p: TEzClipPolygon; heap: PEdgeNodeArray );
Var
  c, total_vertices: integer;
Begin
  total_vertices := 0;
  For c := 0 To p.num_contours - 1 Do
    Inc( total_vertices, count_optimal_vertices( p.contour[c] ) );
  FreeMem( heap, total_vertices * sizeof( TEdgeNode ) );
End;

Procedure GPCPolygonClip( op: TEzPolyClipOp; subject, clipping, result: TEzClipPolygon );
Var
  sbtree: PSBTree;
  it: PITNode;
  aet: PEdgeNode;
  c_heap: PEdgeNodeArray;
  s_heap: PEdgeNodeArray;
  lmt: PLMTNode;
  out_poly: PPolygonNode;
  cf: PPolygonNode;
  parity: Array[0..1] Of integer;
  scanbeam: integer;
  sbt_entries: integer;
  sbt: PDoubleArray;

  intersect: PITNode;
  edge, prev_edge, next_edge, succ_edge, e0, e1: PEdgeNode;
  local_min: PLMTNode;
  p, q, poly, npoly: PPolygonNode;
  vtx, nv: PVertexNode;
  horiz: Array[0..1] Of THState;
  ain, exists: Array[0..1] Of integer;
  c, v, tmpcontours: integer;
  contour: TEzPointList;
  search, contributing: boolean;
  vclass, bl, br, tl, tr: integer;
  xb, px, yb, yt, dy, ix, iy: double;
Begin

  sbtree := Nil;
  it := Nil;
  aet := Nil;
  c_heap := Nil;
  s_heap := Nil;
  lmt := Nil;
  out_poly := Nil;
  cf := Nil;
  parity[0] := LEFT;
  parity[1] := LEFT;

  scanbeam := 0;
  sbt_entries := 0;
  //sbt:= nil;

  (* Test for trivial NIL result cases *)
  If ( ( ( subject.num_contours = 0 ) And ( clipping.num_contours = 0 ) )
    Or ( ( subject.num_contours = 0 ) And ( ( op = pcINT ) Or ( op = pcDIFF ) ) )
    Or ( ( clipping.num_contours = 0 ) And ( op = pcINT ) ) ) Then
  Begin
    result.clear;
    exit;
  End;

  (* Identify potentialy contributing contours *)
  If ( ( ( op = pcINT ) Or ( op = pcDIFF ) ) And
    ( subject.num_contours > 0 ) And ( clipping.num_contours > 0 ) ) Then
    minimax_test( subject, clipping, op );

  (* Build LMT *)
  If subject.num_contours > 0 Then
    s_heap := build_lmt( lmt, sbtree, sbt_entries, subject, SUBJ, op );
  If clipping.num_contours > 0 Then
    c_heap := build_lmt( lmt, sbtree, sbt_entries, clipping, CLIP, op );

  (* Return a NIL result if no contours contribute *)
  If lmt = Nil Then
  Begin
    result.clear;
    freeheap( subject, s_heap );
    freeheap( clipping, c_heap );
    exit;
  End;

  (* Build scanbeam table from scanbeam tree *)
  GetMem( sbt, sbt_entries * sizeof( double ) );
  fillchar( sbt^, sbt_entries * sizeof( double ), 0 );
  build_sbt( scanbeam, sbt, sbtree );
  scanbeam := 0;
  free_sbtree( sbtree );

  (* Invert clipping polygon for difference operation *)
  If op = pcDIFF Then
    parity[CLIP] := RIGHT;

  local_min := lmt;

  (* Process each scanbeam *)
  While scanbeam < sbt_entries Do
  Begin
    (* Set yb and yt to the bottom and top of the scanbeam *)
    yb := sbt[scanbeam];
    yt := 0;
    Inc( scanbeam );
    If scanbeam < sbt_entries Then
    Begin
      yt := sbt[scanbeam];
      dy := yt - yb;
    End;

    (* === SCANBEAM BOUNDARY PROCESSING ================================ *)

    (* If LMT node corresponding to yb exists *)
    If ( local_min <> Nil ) And ( local_min.y = yb ) Then
    Begin
      (* Add edges starting at this local minimum to the AET *)
      edge := local_min.first_bound;
      While edge <> Nil Do
      Begin
        add_edge_to_aet( aet, edge, Nil );
        edge := edge.next_bound;
      End;

      local_min := local_min.next;
    End;

    (* Set dummy previous x value *)
    px := -DBL_MAX;

    (* Create bundles within AET *)
    e0 := aet;
    //e1:= aet;

    (* Set up bundle fields of first edge *)
    aet.bundle[ABOVE, aet.istype] := Ord( ( aet.top.y <> yb ) );
    aet.bundle[ABOVE, ( 1 - aet.istype )] := ord( FALSE );
    aet.bstate[ABOVE] := bsUNBUNDLED;

    next_edge := aet.next;
    While next_edge <> Nil Do
    Begin

      (* Set up bundle fields of next edge *)
      next_edge.bundle[ABOVE, next_edge.istype] := ord( ( next_edge.top.y <> yb ) );
      next_edge.bundle[ABOVE, ( 1 - next_edge.istype )] := ord( FALSE );
      next_edge.bstate[ABOVE] := bsUNBUNDLED;

      (* Bundle edges above the scanbeam boundary if they coincide *)
      If next_edge.bundle[ABOVE, next_edge.istype] <> 0 Then
      Begin
        If ( EQ( e0.xb, next_edge.xb ) And EQ( e0.dx, next_edge.dx ) And
          ( e0.top.y <> yb ) ) Then
        Begin
          next_edge.bundle[ABOVE, next_edge.istype] :=
            next_edge.bundle[ABOVE, next_edge.istype] Xor
            e0.bundle[ABOVE, next_edge.istype];
          next_edge.bundle[ABOVE, ( 1 - next_edge.istype )] :=
            e0.bundle[ABOVE, ( 1 - next_edge.istype )];
          next_edge.bstate[ABOVE] := bsBUNDLE_HEAD;
          e0.bundle[ABOVE, CLIP] := ord( FALSE );
          e0.bundle[ABOVE, SUBJ] := ord( FALSE );
          e0.bstate[ABOVE] := bsBUNDLE_TAIL;
        End;
        e0 := next_edge;
      End;

      next_edge := next_edge.next;
    End;

    horiz[CLIP] := hsNH;
    horiz[SUBJ] := hsNH;

    (* Process each edge at this scanbeam boundary *)
    edge := aet;
    While edge <> Nil Do
    Begin
      exists[CLIP] := edge.bundle[ABOVE, CLIP] +
        ( edge.bundle[BELOW, CLIP] Shl 1 );
      exists[SUBJ] := edge.bundle[ABOVE, SUBJ] +
        ( edge.bundle[BELOW, SUBJ] Shl 1 );

      If boolean( exists[CLIP] ) Or boolean( exists[SUBJ] ) Then
      Begin
        (* Set bundle side *)
        edge.bside[CLIP] := parity[CLIP];
        edge.bside[SUBJ] := parity[SUBJ];

        (* Determine contributing status and quadrant occupancies *)
        bl := 0;
        br := 0;
        tl := 0;
        tr := 0;
        contributing := false;
        Case op Of
          pcDIFF, pcINT:
            Begin
              contributing := ( ( exists[CLIP] <> 0 ) And ( ( parity[SUBJ] <> 0 ) Or
                ( ord( horiz[SUBJ] ) <> 0 ) ) )
                Or ( ( exists[SUBJ] <> 0 ) And ( ( parity[CLIP] <> 0 ) Or
                ( ord( horiz[CLIP] ) <> 0 ) ) )
                Or ( ( exists[CLIP] <> 0 ) And ( exists[SUBJ] <> 0 )
                And ( parity[CLIP] = parity[SUBJ] ) );
              br := parity[CLIP] And parity[SUBJ];
              bl := ( parity[CLIP] Xor edge.bundle[ABOVE, CLIP] )
                And ( parity[SUBJ] Xor edge.bundle[ABOVE, SUBJ] );
              tr := ( parity[CLIP] Xor ord( horiz[CLIP] <> hsNH ) )
                And ( parity[SUBJ] Xor ord( horiz[SUBJ] <> hsNH ) );
              tl := ( parity[CLIP] Xor ord( horiz[CLIP] <> hsNH ) Xor
                edge.bundle[BELOW, CLIP] )
                And ( parity[SUBJ] Xor ord( horiz[SUBJ] <> hsNH ) Xor
                edge.bundle[BELOW, SUBJ] );
            End;
          pcXOR:
            Begin
              contributing := ( exists[CLIP] <> 0 ) Or ( exists[SUBJ] <> 0 );
              br := ( parity[CLIP] )
                Xor ( parity[SUBJ] );
              bl := ( parity[CLIP] Xor edge.bundle[ABOVE, CLIP] )
                Xor ( parity[SUBJ] Xor edge.bundle[ABOVE, SUBJ] );
              tr := ( parity[CLIP] Xor ord( horiz[CLIP] <> hsNH ) )
                Xor ( parity[SUBJ] Xor ord( horiz[SUBJ] <> hsNH ) );
              tl := ( parity[CLIP] Xor ord( horiz[CLIP] <> hsNH ) Xor
                edge.bundle[BELOW, CLIP] )
                Xor ( parity[SUBJ] Xor ord( horiz[SUBJ] <> hsNH ) Xor
                edge.bundle[BELOW, SUBJ] );
            End;
          pcUNION:
            Begin
              contributing := ( ( exists[CLIP] <> 0 ) And ( ( parity[SUBJ] = 0 ) Or
                ( ord( horiz[SUBJ] ) <> 0 ) ) )
                Or ( ( exists[SUBJ] <> 0 ) And ( ( parity[CLIP] = 0 ) Or
                ( ord( horiz[CLIP] ) <> 0 ) ) )
                Or ( ( exists[CLIP] <> 0 ) And ( exists[SUBJ] <> 0 )
                And ( parity[CLIP] = parity[SUBJ] ) );
              br := ( parity[CLIP] )
                Or ( parity[SUBJ] );
              bl := ( parity[CLIP] Xor edge.bundle[ABOVE, CLIP] )
                Or ( parity[SUBJ] Xor edge.bundle[ABOVE, SUBJ] );
              tr := ( parity[CLIP] Xor ord( horiz[CLIP] <> hsNH ) )
                Or ( parity[SUBJ] Xor ord( horiz[SUBJ] <> hsNH ) );
              tl := ( parity[CLIP] Xor ord( horiz[CLIP] <> hsNH ) Xor
                edge.bundle[BELOW, CLIP] )
                Or ( parity[SUBJ] Xor ord( horiz[SUBJ] <> hsNH ) Xor