1 (*
2 ===========================================================================
3
4 Project: Generic Polygon Clipper
5
6 A new algorithm for calculating the difference, intersection,
7 exclusive-or or union of arbitrary polygon sets.
8
9 File: gpc.pas
10 Author: Alan Murta (gpc@cs.man.ac.uk)
11 Version: 2.30
12 Date: 17th October 1998
13
14 Pascal port by: Stefan Schedel (Stefan.Schedel@loewe.de)
15
16 Copyright: (C) 1997, Advanced Interfaces Group, University of Manchester.
17 All rights reserved.
18
19 This software may be freely copied, modified, and redistributed
20 provided that this copyright notice is preserved on all copies.
21 The intellectual property rights of the algorithms used reside
22 with the University of Manchester Advanced Interfaces Group.
23
24 You may not distribute this software, in whole or in part, as
25 part of any commercial product without the express consent of
26 the author.
27
28 There is no warranty or other guarantee of fitness of this
29 software for any purpose. It is provided solely "as is".
30
31 ===========================================================================
32 *)
33
34 unit GPC;
35
36 interface
37 uses
38 Windows;
39 //===========================================================================
40 // Constants
41 //===========================================================================
42
43 const
44 Version = 'GPC_VERSION "2.30"';
45 GPC_EPSILON : double = 2.2204460492503131E-16; { from float.h }
46
47 //===========================================================================
48 // Public Data Types
49 //===========================================================================
50
51 type
52
53 Tgpc_op = { Set operation type }
54 (
55 GPC_DIFF, { Difference }
56 GPC_INT, { Intersection }
57 GPC_XOR, { Exclusive or }
58 GPC_UNION { Union }
59 );
60
61 Tgpc_vertex = record { Polygon vertex structure }
62 x : double; { Vertex x component }
63 y : double; { vertex y component }
64 end;
65
66 Pgpc_vertex_array = ^Tgpc_vertex_array; { Helper Type for indexing }
67 Tgpc_vertex_array = array[0.. MaxInt div sizeof(Tgpc_vertex) - 1] of Tgpc_vertex;
68
69 Pgpc_vertex_list = ^Tgpc_vertex_list; { Vertex list structure }
70 Tgpc_vertex_list = record
71 num_vertices : integer; { Number of vertices in list }
72 vertex : Pgpc_vertex_array; { Vertex array pointer }
73 end;
74
75 PIntegerArray = ^TIntegerArray;
76 TIntegerArray = array[0..MaxInt div sizeof(Integer) - 1] of Integer;
77
78 Pgpc_vertex_list_array = ^Tgpc_vertex_list_array; { Helper Type for indexing }
79 Tgpc_vertex_list_array = array[0.. MaxInt div sizeof(Tgpc_vertex) - 1] of Tgpc_vertex_list;
80
81 Pgpc_polygon = ^Tgpc_polygon;
82 Tgpc_polygon = record { Polygon set structure }
83 num_contours : integer; { Number of contours in polygon }
84 hole : PIntegerArray; { Hole / external contour flags }
85 contour : Pgpc_vertex_list_array; { Contour array pointer }
86 end;
87
88 Pgpc_tristrip = ^Tgpc_tristrip; { Tristrip set structure }
89 Tgpc_tristrip = record
90 num_strips : integer; { Number of tristrips }
91 strip : Pgpc_vertex_list_array; { Tristrip array pointer }
92 end;
93
94
95
96 //===========================================================================
Prototypesnull97 // Public Function Prototypes
98 //===========================================================================
99
100
101 procedure gpc_read_polygon (var f : text; p : Pgpc_polygon);
102
103 procedure gpc_write_polygon (var f : text; p : Pgpc_polygon);
104
105 procedure gpc_add_contour (polygon : Pgpc_polygon;
106 contour : Pgpc_vertex_list;
107 hole : integer);
108
109 procedure gpc_polygon_clip (set_operation : Tgpc_op;
110 subject_polygon : Pgpc_polygon;
111 clip_polygon : Pgpc_polygon;
112 result_polygon : Pgpc_polygon);
113
114 procedure gpc_free_polygon (polygon : Pgpc_polygon);
115
116 procedure gpc_free_tristrip (tristrip : Pgpc_tristrip);
117
118
119
120
121 implementation
122
123 uses
124 SysUtils,
125 Math;
126
127
128
129 //===========================================================================
130 // Constants
131 //===========================================================================
132
133 const
134 DBL_MAX : double = MaxDouble;
135
136 DBL_DIG = 15;
137
138 FFALSE = 0;
139 FTRUE = 1;
140
141 LEFT = 0;
142 RIGHT = 1;
143
144 ABOVE = 0;
145 BELOW = 1;
146
147 CLIP = 0;
148 SUBJ = 1;
149
150 INVERT_TRISTRIPS = FALSE;
151
152
153
154 //===========================================================================
155 // Private Data Types
156 //===========================================================================
157
158 type
159 Tvertex_type =
160 ( { Edge intersection classes }
161 NUL, { Empty non-intersection }
162 EMX, { External maximum }
163 ELI, { External left intermediate }
164 TED, { Top edge }
165 ERI, { External right intermediate }
166 RED, { Right edge }
167 IMM, { Internal maximum and minimum }
168 IMN, { Internal minimum }
169 EMN, { External minimum }
170 EMM, { External maximum and minimum }
171 LED, { Left edge }
172 ILI, { Internal left intermediate }
173 BED, { Bottom edge }
174 IRI, { Internal right intermediate }
175 IMX, { Internal maximum }
176 FUL { Full non-intersection }
177 );
178
179 Th_state = { Horizontal edge states }
180 (
181 NH, { No horizontal edge }
182 BH, { Bottom horizontal edge }
183 TH { Top horizontal edge }
184 );
185
186 Tbundle_state =
187 (
188 UNBUNDLED,
189 BUNDLE_HEAD,
190 BUNDLE_TAIL
191 );
192
193 PPvertex_node = ^Pvertex_node;
194 Pvertex_node = ^Tvertex_node; { Internal vertex list datatype }
195 Tvertex_node = record
196 x : double; { X coordinate component }
197 y : double; { Y coordinate component }
198 next : Pvertex_node; { Pointer to next vertex in list }
199 end;
200
201 Pvertex_node_array = ^Tvertex_node_array; { Helper type for indexing }
202 Tvertex_node_array = array[0..1] of Pvertex_node;
203
204
205 PPpolygon_node = ^Ppolygon_node;
206 Ppolygon_node = ^Tpolygon_node;
207 Tpolygon_node = record
208 active : integer;
209 hole : integer;
210 v : array[0..1] of Pvertex_node;
211 Next : Ppolygon_node;
212 proxy : Ppolygon_node;
213 end;
214
215 PPedge_node = ^Pedge_node;
216 Pedge_node = ^Tedge_node;
217 Tedge_node = record
218 vertex : Tgpc_vertex; { Piggy-backed contour vertex data }
219 bot : Tgpc_vertex; { Edge lower (x, y) coordinate }
220 top : Tgpc_vertex; { Edge upper (x, y) coordinate }
221 xb : double; { Scanbeam bottom x coordinate }
222 xt : double; { Scanbeam top x coordinate }
223 dx : double; { Change in x for a unit y increase }
224 typ : integer; { Clip / subject edge flag }
225 bundle : array[0..1, 0..1] of integer;{ Bundle edge flags }
226 bside : array[0..1] of integer; { Bundle left / right indicators }
227 bstate : array[0..1] of Tbundle_state;{ Edge bundle state }
228 outp : array[0..1] of Ppolygon_node;{ Output polygon / tristrip pointer }
229 prev : Pedge_node; { Previous edge in the AET }
230 next : Pedge_node; { Next edge in the AET }
231 pred : Pedge_node; { Edge connected at the lower end }
232 succ : Pedge_node; { Edge connected at the upper end }
233 next_bound : Pedge_node; { Pointer to next bound in LMT }
234 end;
235
236 PPedge_node_array = ^Pedge_node_array;
237 Pedge_node_array = ^Tedge_node_array;
238 Tedge_node_array = array[0..MaxInt div sizeof(Tedge_node) - 1] of Tedge_node;
239
240 PPlmt_node = ^Plmt_node;
241 Plmt_node = ^Tlmt_node;
242 Tlmt_node = record { Local minima table }
243 y : double; { Y coordinate at local minimum }
244 first_bound: Pedge_node; { Pointer to bound list }
245 next : Plmt_node; { Pointer to next local minimum }
246 end;
247
248 PPsb_tree = ^Psb_tree;
249 Psb_tree = ^Tsb_tree;
250 Tsb_tree = record { Scanbeam tree }
251 y : double; { Scanbeam node y value }
252 less : Psb_tree; { Pointer to nodes with lower y }
253 more : Psb_tree; { Pointer to nodes with higher y }
254 end;
255
256
257 PPit_node = ^Pit_node;
258 Pit_node = ^Tit_node; { Intersection table }
259 Tit_node = record
260 ie : array[0..1] of Pedge_node;{ Intersecting edge (bundle) pair }
261 point : Tgpc_vertex; { Point of intersection }
262 next : Pit_node; { The next intersection table node }
263 end;
264
265 PPst_node = ^Pst_node;
266 Pst_node = ^Tst_node; { Sorted edge table }
267 Tst_node = record
268 edge : Pedge_node; { Pointer to AET edge }
269 xb : double; { Scanbeam bottom x coordinate }
270 xt : double; { Scanbeam top x coordinate }
271 dx : double; { Change in x for a unit y increase }
272 prev : Pst_node; { Previous edge in sorted list }
273 end;
274
275 Pbbox = ^Tbbox;
276 Tbbox = record { Contour axis-aligned bounding box }
277 xmin : double; { Minimum x coordinate }
278 ymin : double; { Minimum y coordinate }
279 xmax : double; { Maximum x coordinate }
280 ymax : double; { Maximum y coordinate }
281 end;
282
283 PbboxArray = ^TbboxArray;
284 TbboxArray = array[0..MaxInt div sizeof(Tbbox) - 1] of Tbbox;
285
286 PDoubleArray = ^TDoubleArray;
287 TDoubleArray = array[0..MaxInt div sizeof(double) - 1] of double;
288
289
290
291 //===========================================================================
fornull292 // C Macros, defined as function for PASCAL
293 //===========================================================================
294
295 function EQ(a, b : double) : boolean; begin EQ := abs(a - b) <= gpc_epsilon end;
NEnull296 function NE(a, b : double) : boolean; begin NE := abs(a - b) > gpc_epsilon end;
GTnull297 function GT(a, b : double) : boolean; begin GT := (a - b) > gpc_epsilon end;
LTnull298 function LT(a, b : double) : boolean; begin LT := (b - a) > gpc_epsilon end;
GEnull299 function GE(a, b : double) : boolean; begin GE := not LT(a, b) end;
LEnull300 function LE(a, b : double) : boolean; begin LE := not GT(a, b) end;
301
PREV_INDEXnull302 function PREV_INDEX(i, n : integer) : integer; begin PREV_INDEX := ((i - 1 + n) mod n); end;
NEXT_INDEXnull303 function NEXT_INDEX(i, n : integer) : integer; begin NEXT_INDEX := ((i + 1) mod n); end;
OPTIMALnull304 function OPTIMAL(v : Pgpc_vertex_array; i, n : integer) : boolean;
305 begin
306 OPTIMAL := NE(v[PREV_INDEX(i, n)].y, v[i].y) or NE(v[NEXT_INDEX(i, n)].y, v[i].y);
307 end;
308
FWD_MINnull309 function FWD_MIN(v : Pedge_node_array; i, n : integer) : boolean;
310 begin
311 FWD_MIN := GE(v[PREV_INDEX(i, n)].vertex.y, v[i].vertex.y) and GT(v[NEXT_INDEX(i, n)].vertex.y, v[i].vertex.y);
312 end;
313
NOT_FMAXnull314 function NOT_FMAX(v : Pedge_node_array; i, n : integer) : boolean;
315 begin
316 NOT_FMAX := GT(v[NEXT_INDEX(i, n)].vertex.y, v[i].vertex.y);
317 end;
318
REV_MINnull319 function REV_MIN(v : Pedge_node_array; i, n : integer) : boolean;
320 begin
321 REV_MIN := GT(v[PREV_INDEX(i, n)].vertex.y, v[i].vertex.y) and GE(v[NEXT_INDEX(i, n)].vertex.y, v[i].vertex.y);
322 end;
323
324
NOT_RMAXnull325 function NOT_RMAX(v : Pedge_node_array; i, n : integer) : boolean;
326 begin
327 NOT_RMAX := GT(v[PREV_INDEX(i, n)].vertex.y, v[i].vertex.y);
328 end;
329
330
331 procedure MALLOC(var p : pointer; b : integer; s : string);
332 begin
333 GetMem(p, b); if (p = nil) and (b <> 0) then raise Exception.Create(s);
334 end;
335
336
337 procedure add_vertex(var p : Pvertex_node; x, y : double);
338 begin
339 if p = nil then
340 begin
341 MALLOC(pointer(p), sizeof(Tvertex_node), 'tristrip vertex creation');
342 p.x := x;
343 p.y := y;
344 p.next := nil;
345 end
346 else
347 { Head further down the list }
348 add_vertex(p.next, x, y);
349 end;
350
351
352 procedure VERTEX(var e : Pedge_node; p, s : integer; var x, y : double);
353 begin
354 add_vertex(e.outp[p].v[s], x, y);
355 Inc(e.outp[p].active);
356 end;
357
358
359 procedure P_EDGE(var d, e : Pedge_node; p : integer; var i, j : double);
360 begin
361 d := e;
362 repeat d := d.prev until d.outp[p] = nil;
363 i := d.bot.x + d.dx * (j - d.bot.y);
364 end;
365
366 procedure N_EDGE(var d, e : Pedge_node; p : integer; var i, j : double);
367 begin
368 d := e;
369 repeat d := d.next; until d.outp[p] = nil;
370 i := d.bot.x + d.dx * (j - d.bot.y);
371 end;
372
373
374 procedure Free(var p : pointer);
375 begin
376 FreeMem(p); p := nil;
377 end;
378
379
380 procedure CFree(var p : pointer);
381 begin
382 if p <> nil then Free(p);
383 end;
384
385
386
387 //===========================================================================
388 // Global Data
389 //===========================================================================
390
391
392
393 { Horizontal edge state transitions within scanbeam boundary }
394 const
395 next_h_state : array[0..2, 0..5] of Th_state =
396 { ABOVE BELOW CROSS }
397 { L R L R L R }
398 { NH } ((BH, TH, TH, BH, NH, NH),
399 { BH } (NH, NH, NH, NH, TH, TH),
400 { TH } (NH, NH, NH, NH, BH, BH));
401
402
403
404
405 //===========================================================================
406 // Private Functions
407 //===========================================================================
408
409
410 procedure reset_it(var it : Pit_node);
411 var
412 itn : Pit_node;
413 begin
414 while (it <> nil) do
415 begin
416 itn := it.next;
417 Free(pointer(it));
418 it := itn;
419 end;
420 end;
421
422
423 procedure reset_lmt(var lmt : Plmt_node);
424 var
425 lmtn : Plmt_node;
426 begin
427 while lmt <> nil do
428 begin
429 lmtn := lmt^.next;
430 Free(pointer(lmt));
431 lmt := lmtn;
432 end;
433 end;
434
435
436 procedure insert_bound(b : PPedge_node_array; e : Pedge_node_array);
437 var
438 existing_bound : pointer;
439 begin
440 if b^ = nil then
441 begin
442 { Link node e to the tail of the list }
443 b^ := e;
444 end
445 else
446 begin
447 { Do primary sort on the x field }
448 if (LT(e[0].bot.x, b^[0].bot.x)) then
449 begin
450 { Insert a new node mid-list }
451 existing_bound := b^;
452 b^ := e;
453 b^[0].next_bound := existing_bound;
454 end
455 else
456 begin
457 if (EQ(e[0].bot.x, b^[0].bot.x)) then
458 begin
459 { Do secondary sort on the dx field }
460 if (LT(e[0].dx, b^[0].dx)) then
461 begin
462 { Insert a new node mid-list }
463 existing_bound := b^;
464 b^ := e;
465 b^[0].next_bound := existing_bound;
466 end
467 else
468 begin
469 { Head further down the list }
470 insert_bound(@(b^[0].next_bound), e);
471 end;
472 end
473 else
474 begin
475 { Head further down the list }
476 insert_bound(@(b^[0].next_bound), e);
477 end;
478 end;
479 end;
480 end;
481
482
bound_listnull483 function bound_list(var lmt : Plmt_node; y : double) : PPedge_node_array;
484 var
485 existing_node : Plmt_node;
486 begin
487 if lmt = nil then
488 begin
489 { Add node onto the tail end of the LMT }
490 MALLOC(pointer(lmt), sizeof(Tlmt_node), 'LMT insertion');
491 lmt.y := y;
492 lmt.first_bound := nil;
493 lmt.next := nil;
494 result := @lmt.first_bound;
495 end
496 else
497 if LT(y, lmt.y) then
498 begin
499 { Insert a new LMT node before the current node }
500 existing_node := lmt;
501 MALLOC(pointer(lmt), sizeof(Tlmt_node), 'LMT insertion');
502 lmt.y := y;
503 lmt.first_bound := nil;
504 lmt.next := existing_node;
505 result := @lmt.first_bound;
506 end
507 else
508 if EQ(y, lmt.y) then
509 { Use this existing LMT node }
510 Result := @lmt.first_bound
511 else
512 { Head further up the LMT }
513 Result := bound_list(lmt.next, y);
514 end;
515
516
517 procedure add_to_sbtree(var entries : integer; var sbtree : Psb_tree; var y : double);
518 begin
519 if sbtree = nil then
520 begin
521 { Add a new tree node here }
522 MALLOC(pointer(sbtree), sizeof(Tsb_tree), 'scanbeam tree insertion');
523 sbtree.y := y;
524 sbtree.less := nil;
525 sbtree.more := nil;
526 Inc(entries);
527 end
528 else
529 begin
530 if GT(sbtree.y, y) then
531 begin
532 { Head into the 'less' sub-tree }
533 add_to_sbtree(entries, sbtree.less, y);
534 end
535 else
536 begin
537 if LT(sbtree.y, y) then
538 begin
539 { Head into the 'more' sub-tree }
540 add_to_sbtree(entries, sbtree.more, y);
541 end;
542 end;
543 end;
544 end;
545
546
547 procedure build_sbt(var entries : integer; var sbt : TDoubleArray; sbtree : Psb_tree);
548 begin
549 if sbtree.less <> nil then
550 build_sbt(entries, sbt, sbtree.less);
551 sbt[entries] := sbtree.y;
552 Inc(entries);
553 if sbtree.more <> nil then
554 build_sbt(entries, sbt, sbtree.more);
555 end;
556
557
558 procedure free_sbtree(var sbtree : Psb_tree);
559 begin
560 if sbtree <> nil then
561 begin
562 free_sbtree(sbtree.less);
563 free_sbtree(sbtree.more);
564 Free(pointer(sbtree));
565 end;
566 end;
567
568
count_optimal_verticesnull569 function count_optimal_vertices(c : Tgpc_vertex_list) : integer;
570 var
571 i : integer;
572 begin
573 Result := 0;
574
575 { Ignore non-contributing contours }
576 if c.num_vertices > 0 then
577 begin
578 for i := 0 to c.num_vertices - 1 do
579 { Ignore superfluous vertices embedded in horizontal edges }
580 if OPTIMAL(c.vertex, i, c.num_vertices) then Inc(Result);
581 end;
582 end;
583
584
build_lmtnull585 function build_lmt(var lmt : Plmt_node; var sbtree : Psb_tree; var sbt_entries : integer;
586 p : Pgpc_polygon; typ : integer; op : Tgpc_op) : Pedge_node_array;
587
588 var
589 c, i, min, max, num_edges, v, num_vertices : integer;
590 total_vertices, e_index : integer;
591 e, edge_table : Pedge_node_array;
592 begin
593 total_vertices := 0; e_index := 0;
594
595 for c := 0 to p.num_contours - 1 do
596 Inc(total_vertices, count_optimal_vertices(p.contour[c]));
597
598 { Create the entire input polygon edge table in one go }
599 MALLOC(pointer(edge_table), total_vertices * sizeof(Tedge_node),
600 'edge table creation');
601
602 for c := 0 to p.num_contours - 1 do
603 begin
604 if p.contour[c].num_vertices < 0 then
605 begin
606 { Ignore the non-contributing contour and repair the vertex count }
607 p.contour[c].num_vertices := -p.contour[c].num_vertices;
608 end
609 else
610 begin
611 { Perform contour optimisation }
612 num_vertices := 0;
613 for i := 0 to p.contour[c].num_vertices - 1 do
614 if (OPTIMAL(p.contour[c].vertex, i, p.contour[c].num_vertices)) then
615 begin
616 edge_table[num_vertices].vertex.x := p.contour[c].vertex[i].x;
617 edge_table[num_vertices].vertex.y := p.contour[c].vertex[i].y;
618
619 { Record vertex in the scanbeam table }
620 add_to_sbtree(sbt_entries, sbtree, edge_table[num_vertices].vertex.y);
621
622 Inc(num_vertices);
623 end;
624
625 { Do the contour forward pass }
626 for min := 0 to num_vertices - 1 do
627 begin
628 { If a forward local minimum... }
629 if FWD_MIN(edge_table, min, num_vertices) then
630 begin
631 { Search for the next local maximum... }
632 num_edges := 1;
633 max := NEXT_INDEX(min, num_vertices);
634 while (NOT_FMAX(edge_table, max, num_vertices)) do
635 begin
636 Inc(num_edges);
637 max := NEXT_INDEX(max, num_vertices);
638 end;
639
640 { Build the next edge list }
641 e := @edge_table[e_index];
642 Inc(e_index, num_edges);
643 v := min;
644 e[0].bstate[BELOW] := UNBUNDLED;
645 e[0].bundle[BELOW][CLIP] := FFALSE;
646 e[0].bundle[BELOW][SUBJ] := FFALSE;
647 for i := 0 to num_edges - 1 do
648 begin
649 e[i].xb := edge_table[v].vertex.x;
650 e[i].bot.x := edge_table[v].vertex.x;
651 e[i].bot.y := edge_table[v].vertex.y;
652
653 v := NEXT_INDEX(v, num_vertices);
654
655 e[i].top.x := edge_table[v].vertex.x;
656 e[i].top.y := edge_table[v].vertex.y;
657 e[i].dx := (edge_table[v].vertex.x - e[i].bot.x) /
658 (e[i].top.y - e[i].bot.y);
659 e[i].typ := typ;
660 e[i].outp[ABOVE] := nil;
661 e[i].outp[BELOW] := nil;
662 e[i].next := nil;
663 e[i].prev := nil;
664 if (num_edges > 1) and (i < (num_edges - 1)) then e[i].succ := @e[i + 1] else
665 e[i].succ := nil;
666 if (num_edges > 1) and (i > 0) then e[i].pred := @e[i - 1] else e[i].pred := nil;
667 e[i].next_bound := nil;
668 if op = GPC_DIFF then e[i].bside[CLIP] := RIGHT else e[i].bside[CLIP] := LEFT;
669 e[i].bside[SUBJ] := LEFT;
670 end;
671 insert_bound(bound_list(lmt, edge_table[min].vertex.y), e);
672 end;
673 end;
674
675 { Do the contour reverse pass }
676 for min := 0 to num_vertices - 1 do
677 begin
678 { If a reverse local minimum... }
679 if REV_MIN(edge_table, min, num_vertices) then
680 begin
681 { Search for the previous local maximum... }
682 num_edges := 1;
683 max := PREV_INDEX(min, num_vertices);
684 while NOT_RMAX(edge_table, max, num_vertices) do
685 begin
686 Inc(num_edges);
687 max := PREV_INDEX(max, num_vertices);
688 end;
689
690 { Build the previous edge list }
691 e := @edge_table[e_index];
692 Inc(e_index, num_edges);
693 v := min;
694 e[0].bstate[BELOW] := UNBUNDLED;
695 e[0].bundle[BELOW][CLIP] := FFALSE;
696 e[0].bundle[BELOW][SUBJ] := FFALSE;
697 for i := 0 to num_edges - 1 do
698 begin
699 e[i].xb := edge_table[v].vertex.x;
700 e[i].bot.x := edge_table[v].vertex.x;
701 e[i].bot.y := edge_table[v].vertex.y;
702
703 v := PREV_INDEX(v, num_vertices);
704
705 e[i].top.x := edge_table[v].vertex.x;
706 e[i].top.y := edge_table[v].vertex.y;
707 e[i].dx := (edge_table[v].vertex.x - e[i].bot.x) /
708 (e[i].top.y - e[i].bot.y);
709 e[i].typ := typ;
710 e[i].outp[ABOVE] := nil;
711 e[i].outp[BELOW] := nil;
712 e[i].next := nil;
713 e[i].prev := nil;
714 if (num_edges > 1) and (i < (num_edges - 1)) then e[i].succ := @e[i + 1] else
715 e[i].succ := nil;
716 if (num_edges > 1) and (i > 0) then e[i].pred := @e[i - 1] else e[i].pred := nil;
717 e[i].next_bound := nil;
718 if op = GPC_DIFF then e[i].bside[CLIP] := RIGHT else e[i].bside[CLIP] := LEFT;
719 e[i].bside[SUBJ] := LEFT;
720 end;
721 insert_bound(bound_list(lmt, edge_table[min].vertex.y), e);
722 end;
723 end;
724 end;
725 end;
726 Result := edge_table;
727 end;
728
729
730
731 procedure add_edge_to_aet(var aet : Pedge_node; edge : Pedge_node; prev : Pedge_node);
732 begin
733 if aet = nil then
734 begin
735 { Append edge onto the tail end of the AET }
736 aet := edge;
737 edge.prev := prev;
738 edge.next := nil;
739 end
740 else
741 begin
742 { Do primary sort on the xb field }
743 if LT(edge.xb, aet.xb) then
744 begin
745 { Insert edge here (before the AET edge) }
746 edge.prev := prev;
747 edge.next := aet;
748 aet.prev := edge;
749 aet := edge;
750 end
751 else
752 begin
753 if EQ(edge.xb, aet.xb) then
754 begin
755 { Do secondary sort on the dx field }
756 if LT(edge.dx, aet.dx) then
757 begin
758 { Insert edge here (before the AET edge) }
759 edge.prev := prev;
760 edge.next := aet;
761 aet.prev := edge;
762 aet := edge;
763 end
764 else
765 begin
766 { Head further into the AET }
767 add_edge_to_aet(aet.next, edge, aet);
768 end;
769 end
770 else
771 begin
772 { Head further into the AET }
773 add_edge_to_aet(aet.next, edge, aet);
774 end;
775 end;
776 end;
777 end;
778
779
780
781 procedure add_intersection(var it : Pit_node; edge0, edge1 : Pedge_node; x, y : double);
782 var
783 existing_node : Pit_node;
784 begin
785
786 if it = nil then
787 begin
788 { Append a new node to the tail of the list }
789 MALLOC(pointer(it), sizeof(Tit_node), 'IT insertion');
790 it.ie[0] := edge0;
791 it.ie[1] := edge1;
792 it.point.x := x;
793 it.point.y := y;
794 it.next := nil;
795 end
796 else
797 begin
798 if GT(it.point.y, y) then
799 begin
800 { Insert a new node mid-list }
801 existing_node := it;
802 MALLOC(pointer(it), sizeof(Tit_node), 'IT insertion');
803 it.ie[0] := edge0;
804 it.ie[1] := edge1;
805 it.point.x := x;
806 it.point.y := y;
807 it.next := existing_node;
808 end
809 else
810 { Head further down the list }
811 add_intersection(it.next, edge0, edge1, x, y);
812 end;
813 end;
814
815
816
817 procedure add_st_edge(var st : Pst_node; var it : Pit_node; edge : Pedge_node; dy : double);
818 var
819 existing_node : Pst_node;
820 den, x, y, r : double;
821 begin
822 if st = nil then
823 begin
824 { Append edge onto the tail end of the ST }
825 MALLOC(pointer(st), sizeof(Tst_node), 'ST insertion');
826 st.edge := edge;
827 st.xb := edge.xb;
828 st.xt := edge.xt;
829 st.dx := edge.dx;
830 st.prev := nil;
831 end
832 else
833 begin
834 den := (st.xt - st.xb) - (edge.xt - edge.xb);
835
836 { If new edge and ST edge don't cross }
837 if (GE(edge.xt, st.xt) or EQ(edge.dx, st.dx) or EQ(den, 0.0)) then
838 begin
839 { No intersection - insert edge here (before the ST edge) }
840 existing_node := st;
841 MALLOC(pointer(st), sizeof(Tst_node), 'ST insertion');
842 st.edge := edge;
843 st.xb := edge.xb;
844 st.xt := edge.xt;
845 st.dx := edge.dx;
846 st.prev := existing_node;
847 end
848 else
849 begin
850 { Compute intersection between new edge and ST edge }
851 r := (edge.xb - st.xb) / den;
852 x := st.xb + r * (st.xt - st.xb);
853 y := r * dy;
854
855 { Insert the edge pointers and the intersection point in the IT }
856 add_intersection(it, st.edge, edge, x, y);
857
858 { Head further into the ST }
859 add_st_edge(st.prev, it, edge, dy);
860
861 end;
862 end;
863 end;
864
865
866
867 procedure build_intersection_table(var it : Pit_node; aet : Pedge_node; dy : double);
868 var
869 st, stp : Pst_node;
870 edge : Pedge_node;
871 begin
872
873 { Build intersection table for the current scanbeam }
874 reset_it(it);
875 st := nil;
876
877 { Process each AET edge }
878 edge := aet;
879 while edge <> nil do
880 begin
881 if (edge.bstate[ABOVE] = BUNDLE_HEAD) or
882 (edge.bundle[ABOVE][CLIP] <> 0) or (edge.bundle[ABOVE][SUBJ] <> 0) then
883 add_st_edge(st, it, edge, dy);
884 edge := edge.next;
885 end;
886
887 { Free the sorted edge table }
888 while st <> nil do
889 begin
890 stp := st.prev;
891 Free(pointer(st));
892 st := stp;
893 end;
894 end;
895
896
897
count_contoursnull898 function count_contours(polygon : Ppolygon_node) : integer;
899 var
900 nv : integer;
901 v, nextv : Pvertex_node;
902 begin
903
904 Result := 0;
905 while polygon <> nil do
906 begin
907 if polygon.active <> 0 then
908 begin
909 { Count the vertices in the current contour }
910 nv := 0;
911 v := polygon.proxy.v[LEFT];
912 while v <> nil do begin Inc(nv); v := v.next; end;
913
914 { Record valid vertex counts in the active field }
915 if (nv > 2) then
916 begin
917 polygon.active := nv;
918 Inc(Result);
919 end
920 else
921 begin
922 { Invalid contour: just free the heap }
923 v := polygon.proxy.v[LEFT];
924 while v <> nil do begin nextv := v.next; FREE(pointer(v)); v := nextv; end;
925 polygon.active := 0;
926 end;
927 end;
928
929 polygon := polygon.next;
930 end;
931 end;
932
933
934 procedure add_left(p : Ppolygon_node; x, y : double);
935 var
936 nv : Pvertex_node;
937 begin
938 { Create a new vertex node and set its fields }
939 MALLOC(pointer(nv), sizeof(Tvertex_node), 'vertex node creation');
940 nv.x := x;
941 nv.y := y;
942
943 { Add vertex nv to the left end of the polygon's vertex list }
944 nv.next := P.proxy.v[LEFT];
945
946 { Update proxy[LEFT] to point to nv }
947 P.proxy.v[LEFT] := nv;
948 end;
949
950
951 procedure merge_left(P : Ppolygon_node; Q :Ppolygon_node; list : Ppolygon_node);
952 var
953 target : Ppolygon_node;
954 begin
955 { Label contour as a hole }
956 q.proxy.hole := FTRUE;
957
958 if P.proxy <> Q.proxy then
959 begin
960 { Assign P's vertex list to the left end of Q's list }
961 P.proxy.v[RIGHT].next := Q.proxy.v[LEFT];
962 Q.proxy.v[LEFT] := P.proxy.v[LEFT];
963
964 { Redirect any P->proxy references to Q->proxy }
965 target := P.proxy;
966 while list <> nil do
967 begin
968 if list.proxy = target then
969 begin
970 list.active := FFALSE;
971 list.proxy := Q.proxy;
972 end;
973 list := list.next;
974 end;
975 end;
976 end;
977
978
979 procedure add_right(P : Ppolygon_node; x, y : double);
980 var
981 nv : Pvertex_node;
982 begin
983
984 { Create a new vertex node and set its fields }
985 MALLOC(pointer(nv), sizeof(Tvertex_node), 'vertex node creation');
986 nv.x := x;
987 nv.y := y;
988 nv.next := nil;
989
990 { Add vertex nv to the right end of the polygon's vertex list }
991 P.proxy.v[RIGHT].next := nv;
992
993 { Update proxy.v[RIGHT] to point to nv }
994 P.proxy.v[RIGHT] := nv;
995 end;
996
997
998 procedure merge_right(P : Ppolygon_node; Q : Ppolygon_node; list : Ppolygon_node);
999 var
1000 target : PPolygon_node;
1001 begin
1002 { Label contour as external }
1003 Q.proxy.hole := FFALSE;
1004
1005 if P.proxy <> Q.proxy then
1006 begin
1007 { Assign P's vertex list to the right end of Q's list }
1008 Q.proxy.v[RIGHT].next := P.proxy.v[LEFT];
1009 Q.proxy.v[RIGHT] := P.proxy.v[RIGHT];
1010
1011 { Redirect any P->proxy references to Q->proxy }
1012 target := P.proxy;
1013 while list <> nil do
1014 begin
1015 if list.proxy = target then
1016 begin
1017 list.active := FFALSE;
1018 list.proxy := Q.proxy;
1019 end;
1020 list := list.next;
1021 end;
1022 end;
1023 end;
1024
1025
1026 procedure add_local_min(P : PPpolygon_node; edge : Pedge_node; x, y : double);
1027 var
1028 nv : Pvertex_node;
1029 existing_min : Ppolygon_node;
1030 begin
1031 existing_min := p^;
1032
1033 MALLOC(pointer(P^), sizeof(Tpolygon_node), 'polygon node creation');
1034
1035 { Create a new vertex node and set its fields }
1036 MALLOC(pointer(nv), sizeof(Tvertex_node), 'vertex node creation');
1037 nv.x := x;
1038 nv.y := y;
1039 nv.next := nil;
1040
1041 { Initialise proxy to point to p itself }
1042 p^.proxy := P^;
1043 p^.active := FTRUE;
1044 p^.next := existing_min;
1045
1046 { Make v[LEFT] and v[RIGHT] point to new vertex nv }
1047 p^.v[LEFT] := nv;
1048 p^.v[RIGHT] := nv;
1049
1050 { Assign polygon p to the edge }
1051 edge.outp[ABOVE] := p^;
1052 end;
1053
1054
count_tristripsnull1055 function count_tristrips(tn : Ppolygon_node) : integer;
1056 begin
1057 Result := 0;
1058
1059 while tn <> nil do
1060 begin
1061 if tn.active > 2 then Inc(Result);
1062 tn := tn.next;
1063 end;
1064 end;
1065
1066 (*
1067 procedure add_vertex(t : PPvertex_node; x, y : double)
1068 begin
1069 if t^ <> nil then
1070 begin
1071 MALLOC(t^, sizeof(Tvertex_node), ttristrip vertex creationt');
1072 t^.x := x;
1073 t^.y := y;
1074 t^.next := nil;
1075 end
1076 else
1077 { Head further down the list }
1078 add_vertex(@t^.next, x, y);
1079 end;
1080 *)
1081
1082 procedure new_tristrip(var tn : Ppolygon_node; edge : Pedge_node; x, y : double);
1083 begin
1084 if tn = nil then
1085 begin
1086 MALLOC(pointer(tn), sizeof(Tpolygon_node), 'tristrip node creation');
1087 tn.next := nil;
1088 tn.v[LEFT] := nil;
1089 tn.v[RIGHT] := nil;
1090 tn.active := 1;
1091 add_vertex(tn.v[LEFT], x, y);
1092 edge.outp[ABOVE] := tn;
1093 end
1094 else
1095 { Head further down the list }
1096 new_tristrip(tn.next, edge, x, y);
1097 end;
1098
1099
create_contour_bboxesnull1100 function create_contour_bboxes(p : Pgpc_polygon) : PbboxArray;
1101 var
1102 c, v : integer;
1103 begin
1104 MALLOC(pointer(Result), p.num_contours * sizeof(Tbbox), 'Bounding box creation');
1105
1106 { Construct contour bounding boxes }
1107 for c := 0 to p.num_contours - 1 do
1108 begin
1109 { Initialise bounding box extent }
1110 Result[c].xmin := DBL_MAX;
1111 Result[c].ymin := DBL_MAX;
1112 Result[c].xmax := -DBL_MAX;
1113 Result[c].ymax := -DBL_MAX;
1114
1115 for v := 0 to p.contour[c].num_vertices - 1 do
1116 begin
1117 { Adjust bounding Result }
1118 if (p.contour[c].vertex[v].x < Result[c].xmin) then
1119 Result[c].xmin := p.contour[c].vertex[v].x;
1120 if (p.contour[c].vertex[v].y < Result[c].ymin) then
1121 Result[c].ymin := p.contour[c].vertex[v].y;
1122 if (p.contour[c].vertex[v].x > Result[c].xmax) then
1123 Result[c].xmax := p.contour[c].vertex[v].x;
1124 if (p.contour[c].vertex[v].y > Result[c].ymax) then
1125 Result[c].ymax := p.contour[c].vertex[v].y;
1126 end;
1127 end;
1128 end;
1129
1130
1131 procedure minimax_test(subj : Pgpc_polygon; clip : Pgpc_polygon; op : Tgpc_op);
1132 var
1133 s_bbox, c_bbox : PbboxArray;
1134 s, c : integer;
1135 o_table : PIntegerArray;
1136 overlap : integer;
1137 begin
1138 s_bbox := create_contour_bboxes(subj);
1139 c_bbox := create_contour_bboxes(clip);
1140
1141 MALLOC(pointer(o_table), subj.num_contours * clip.num_contours * sizeof(Integer),
1142 'overlap table creation');
1143
1144 { Check all subject contour bounding boxes against clip boxes }
1145 for s := 0 to subj.num_contours - 1 do
1146 for c := 0 to clip.num_contours - 1 do
1147 o_table[c * subj.num_contours + s] := integer(
1148 (not(LT(s_bbox[s].xmax, c_bbox[c].xmin) or
1149 GT(s_bbox[s].xmin, c_bbox[c].xmax))) and
1150 (not(LT(s_bbox[s].ymax, c_bbox[c].ymin) or
1151 GT(s_bbox[s].ymin, c_bbox[c].ymax))));
1152
1153 { For each clip contour, search for any subject contour overlaps }
1154 for c := 0 to clip.num_contours - 1 do
1155 begin
1156 overlap := 0; s := 0;
1157 while (overlap = 0) and (s < subj.num_contours) do
1158 begin
1159 overlap := o_table[c * subj.num_contours + s];
1160 Inc(s);
1161 end;
1162
1163 if overlap = 0 then
1164 { Flag non contributing status by negating vertex count }
1165 clip.contour[c].num_vertices := -clip.contour[c].num_vertices;
1166 end;
1167
1168 if (op = GPC_INT) then
1169 begin
1170 { For each subject contour, search for any clip contour overlaps }
1171 for s := 0 to subj.num_contours - 1 do
1172 begin
1173 overlap := 0; c := 0;
1174 while (overlap = 0) and (c < clip.num_contours) do
1175 begin
1176 overlap := o_table[c * subj.num_contours + s];
1177 Inc(c);
1178 end;
1179
1180 if overlap = 0 then
1181 { Flag non contributing status by negating vertex count }
1182 subj.contour[s].num_vertices := -subj.contour[s].num_vertices;
1183 end;
1184 end;
1185
1186 FREE(pointer(s_bbox));
1187 FREE(pointer(c_bbox));
1188 FREE(pointer(o_table));
1189 end;
1190
1191
1192 //===========================================================================
1193 // Public Functions
1194 //===========================================================================
1195
1196
1197 procedure gpc_free_polygon(Polygon : Pgpc_polygon);
1198 var
1199 c : integer;
1200 begin
1201 for c := 0 to Polygon.num_contours - 1 do
1202 CFree(pointer(Polygon.contour[c].vertex));
1203
1204 CFree(pointer(Polygon.hole));
1205 CFree(pointer(Polygon.contour));
1206 Polygon.num_contours := 0;
1207 end;
1208
1209
1210 procedure gpc_read_polygon(var f : text; p : Pgpc_polygon);
1211 var
1212 c, v : integer;
1213 begin
1214 readln(f, p.num_contours);
1215 MALLOC(pointer(p.contour), p.num_contours * sizeof(Tgpc_vertex_list), 'contour creation');
1216 for c := 0 to p.num_contours - 1 do
1217 begin
1218 readln(f, p.contour[c].num_vertices);
1219 MALLOC(pointer(p.contour[c].vertex), p.contour[c].num_vertices * sizeof(Tgpc_vertex), 'vertex creation');
1220 for v := 0 to p.contour[c].num_vertices - 1 do
1221 begin
1222 read(f, p.contour[c].vertex[v].x);
1223 readln(f, p.contour[c].vertex[v].y);
1224 end;
1225 end;
1226 end;
1227
1228
1229 procedure gpc_write_polygon(var f : text; p : Pgpc_polygon);
1230 var
1231 c, v : integer;
1232 begin
1233 writeln(f, p.num_contours);
1234 for c := 0 to p.num_contours - 1 do
1235 begin
1236 writeln(f, p.contour[c].num_vertices);
1237 for v := 0 to p.contour[c].num_vertices - 1 do
1238 writeln(f, p.contour[c].vertex[v].x:20:DBL_DIG , ' ' , p.contour[c].vertex[v].y:20:DBL_DIG);
1239 end;
1240 end;
1241
1242
1243 procedure gpc_add_contour(polygon : Pgpc_polygon; contour : Pgpc_vertex_list; hole : integer);
1244 var
1245 c, v : integer;
1246 extended_hole : PIntegerArray;
1247 extended_contour : Pgpc_vertex_list_array;
1248 begin
1249
1250 { Create an extended hole array }
1251 MALLOC(pointer(extended_hole), (polygon.num_contours + 1)
1252 * sizeof(integer), 'contour hole addition');
1253
1254 { Create an extended contour array }
1255 MALLOC(pointer(extended_contour), (polygon.num_contours + 1)
1256 * sizeof(Tgpc_vertex_list), 'contour addition');
1257
1258 { Copy the old contour into the extended contour array }
1259 for c := 0 to polygon.num_contours - 1 do
1260 begin
1261 extended_hole[c] := polygon.hole[c];
1262 extended_contour[c] := polygon.contour[c];
1263 end;
1264
1265 { Copy the new contour onto the end of the extended contour array }
1266 c := polygon.num_contours;
1267 extended_hole[c] := hole;
1268 extended_contour[c].num_vertices := contour.num_vertices;
1269 MALLOC(pointer(extended_contour[c].vertex), contour.num_vertices
1270 * sizeof(Tgpc_vertex), 'contour addition');
1271 for v := 0 to contour.num_vertices - 1 do
1272 extended_contour[c].vertex[v] := contour.vertex[v];
1273
1274 { Dispose of the old contour }
1275 CFREE(pointer(polygon.contour));
1276 CFREE(pointer(polygon.hole));
1277
1278 { Update the polygon information }
1279 Inc(polygon.num_contours);
1280 polygon.hole := extended_hole;
1281 polygon.contour := extended_contour;
1282 end;
1283
1284
1285 procedure gpc_polygon_clip(set_operation : Tgpc_op; subject_polygon : Pgpc_polygon;
1286 clip_polygon : Pgpc_polygon; result_polygon : Pgpc_polygon);
1287
1288 var
1289 sbtree : Psb_tree;
1290 it, intersect : Pit_node;
1291 edge, prev_edge, next_edge, succ_edge : Pedge_node;
1292 e0, e1 : Pedge_node;
1293 aet : Pedge_node;
1294 c_heap, s_heap : Pedge_node_array;
1295 lmt, local_min : Plmt_node;
1296 out_poly, P, Q, poly, npoly, cf : Ppolygon_node;
1297 vtx, nv : Pvertex_node;
1298 horiz : array[0..1] of Th_state;
1299 inn, exists, parity : array[0..1] of integer;
1300 c, v, contributing, search, scanbeam : integer;
1301 sbt_entries, _class, bl, br, tl, tr : integer;
1302 sbt : PDoubleArray;
1303 xb, px, yb, yt, dy, ix, iy : double;
1304 begin
1305 edge := nil;
1306 sbtree := nil; it := nil; aet := nil; lmt := nil;
1307 out_poly := nil; cf := nil;
1308 inn[0] := LEFT; inn[1] := LEFT;
1309 exists[0] := LEFT; exists[1] := LEFT;
1310 parity[0] := LEFT; parity[1] := LEFT;
1311 scanbeam := 0; sbt_entries := 0;
1312 sbt := nil;
1313
1314 { Test for trivial NULL result cases }
1315 if ((subject_polygon.num_contours = 0) and (clip_polygon.num_contours = 0))
1316 or ((subject_polygon.num_contours = 0) and ((set_operation = GPC_INT) or (set_operation = GPC_DIFF)))
1317 or ((clip_polygon.num_contours = 0) and (set_operation = GPC_INT)) then
1318 begin
1319 result_polygon.num_contours := 0;
1320 result_polygon.hole := nil;
1321 result_polygon.contour := nil;
1322 exit;
1323 end;
1324
1325 { Identify potentialy contributing contours }
1326 if (((set_operation = GPC_INT) or (set_operation = GPC_DIFF))
1327 and (subject_polygon.num_contours > 0) and (clip_polygon.num_contours > 0)) then
1328 minimax_test(subject_polygon, clip_polygon, set_operation);
1329
1330 { Build LMT }
1331 if subject_polygon.num_contours > 0 then
1332 s_heap := build_lmt(lmt, sbtree, sbt_entries, subject_polygon, SUBJ, set_operation);
1333 if clip_polygon.num_contours > 0 then
1334 c_heap := build_lmt(lmt, sbtree, sbt_entries, clip_polygon, CLIP, set_operation);
1335
1336 { Return a NULL result if no contours contribute }
1337 if lmt = nil then
1338 begin
1339 result_polygon.num_contours := 0;
1340 result_polygon.hole := nil;
1341 result_polygon.contour := nil;
1342 reset_lmt(lmt);
1343 FREE(pointer(s_heap));
1344 FREE(pointer(c_heap));
1345 exit;
1346 end;
1347
1348 { Build scanbeam table from scanbeam tree }
1349 MALLOC(pointer(sbt), sbt_entries * sizeof(double), 'sbt creation');
1350 build_sbt(scanbeam, sbt^, sbtree);
1351 scanbeam := 0;
1352 free_sbtree(sbtree);
1353
1354 { Allow pointer re-use without causing memory leak }
1355 if subject_polygon = result_polygon then
1356 gpc_free_polygon(subject_polygon);
1357 if clip_polygon = result_polygon then
1358 gpc_free_polygon(clip_polygon);
1359
1360 { Invert clip polygon for difference operation }
1361 if set_operation = GPC_DIFF then
1362 parity[CLIP] := RIGHT;
1363
1364 local_min := lmt;
1365
1366 { Process each scanbeam }
1367 while (scanbeam < sbt_entries) do
1368 begin
1369 { Set yb and yt to the bottom and top of the scanbeam }
1370 yb := sbt[scanbeam]; Inc(scanbeam);
1371 if scanbeam < sbt_entries then
1372 begin
1373 yt := sbt[scanbeam];
1374 dy := yt - yb;
1375 end;
1376
1377 { === SCANBEAM BOUNDARY PROCESSING ================================ }
1378
1379 { If LMT node corresponding to yb exists }
1380 if local_min <> nil then
1381 begin
1382 if EQ(local_min.y, yb) then
1383 begin
1384 { Add edges starting at this local minimum to the AET }
1385 edge := local_min.first_bound;
1386 while edge <> nil do
1387 begin
1388 add_edge_to_aet(aet, edge, nil);
1389 edge := edge.next_bound;
1390 end;
1391 local_min := local_min.next;
1392 end;
1393 end;
1394
1395 { Set dummy previous x value }
1396 px := -DBL_MAX;
1397
1398 { Create bundles within AET }
1399 e0 := aet;
1400 e1 := aet;
1401
1402 { Set up bundle fields of first edge }
1403 aet.bundle[ABOVE][integer(aet.typ <> 0)] := integer(NE(aet.top.y, yb));
1404 aet.bundle[ABOVE][integer(aet.typ = 0)] := FFALSE;
1405 aet.bstate[ABOVE] := UNBUNDLED;
1406
1407 next_edge := aet.next;
1408
1409 while next_edge <> nil do
1410 begin
1411 { Set up bundle fields of next edge }
1412 next_edge.bundle[ABOVE][next_edge.typ] := integer(NE(next_edge.top.y, yb));
1413 next_edge.bundle[ABOVE][integer(next_edge.typ = 0)] := FFALSE;
1414 next_edge.bstate[ABOVE] := UNBUNDLED;
1415
1416 { Bundle edges above the scanbeam boundary if they coincide }
1417 if next_edge.bundle[ABOVE][next_edge.typ] <> 0 then
1418 begin
1419 if (EQ(e0.xb, next_edge.xb) and EQ(e0.dx, next_edge.dx)
1420 and NE(e0.top.y, yb)) then
1421 begin
1422 next_edge.bundle[ABOVE][next_edge.typ] := next_edge.bundle[ABOVE][next_edge.typ] xor
1423 e0.bundle[ABOVE][ next_edge.typ];
1424 next_edge.bundle[ABOVE][integer(next_edge.typ = 0)] :=
1425 e0.bundle[ABOVE][integer(next_edge.typ = 0)];
1426 next_edge.bstate[ABOVE] := BUNDLE_HEAD;
1427 e0.bundle[ABOVE][CLIP] := FFALSE;
1428 e0.bundle[ABOVE][SUBJ] := FFALSE;
1429 e0.bstate[ABOVE] := BUNDLE_TAIL;
1430 end;
1431 e0 := next_edge;
1432 end;
1433 next_edge := next_edge.next;
1434 end;
1435
1436 horiz[CLIP] := NH;
1437 horiz[SUBJ] := NH;
1438
1439 { Process each edge at this scanbeam boundary }
1440 edge := aet;
1441 while edge <> nil do
1442 begin
1443 exists[CLIP] := edge.bundle[ABOVE][CLIP] +
1444 (edge.bundle[BELOW][CLIP] shl 1);
1445 exists[SUBJ] := edge.bundle[ABOVE][SUBJ] +
1446 (edge.bundle[BELOW][SUBJ] shl 1);
1447
1448 if (exists[CLIP] <> 0) or (exists[SUBJ] <> 0) then
1449 begin
1450 { Set bundle side }
1451 edge.bside[CLIP] := parity[CLIP];
1452 edge.bside[SUBJ] := parity[SUBJ];
1453
1454 { Determine contributing status and quadrant occupancies }
1455 case set_operation of
1456 GPC_DIFF,
1457 GPC_INT: begin
1458 contributing := integer( ((exists[CLIP] <> 0) and ((parity[SUBJ] <> 0) or (horiz[SUBJ] <> NH)))
1459 or ((exists[SUBJ] <> 0) and ((parity[CLIP] <> 0) or (horiz[CLIP] <> NH)))
1460 or ((exists[CLIP] <> 0) and (exists[SUBJ] <> 0) and (parity[CLIP] = parity[SUBJ])));
1461 br := integer((parity[CLIP] <> 0) and (parity[SUBJ] <> 0));
1462 bl := integer( ((parity[CLIP] xor edge.bundle[ABOVE][CLIP]) <> 0)
1463 and ((parity[SUBJ] xor edge.bundle[ABOVE][SUBJ]) <> 0));
1464 tr := integer( ((parity[CLIP] xor integer(horiz[CLIP] <> NH)) <> 0)
1465 and ((parity[SUBJ] xor integer(horiz[SUBJ] <> NH)) <> 0));
1466 tl := integer( ((parity[CLIP] xor integer(horiz[CLIP] <> NH) xor edge.bundle[BELOW][CLIP]) <> 0)
1467 and ((parity[SUBJ] xor integer(horiz[SUBJ] <> NH) xor edge.bundle[BELOW][SUBJ]) <> 0));
1468 end;
1469
1470 GPC_XOR: begin
1471 contributing := integer((exists[CLIP] <> 0) or (exists[SUBJ] <> 0));
1472 br := integer(parity[CLIP] xor parity[SUBJ]);
1473 bl := integer( ((parity[CLIP] xor edge.bundle[ABOVE][CLIP]) <> 0)
1474 xor ((parity[SUBJ] xor edge.bundle[ABOVE][SUBJ]) <> 0));
1475 tr := integer( ((parity[CLIP] xor integer(horiz[CLIP] <> NH)) <> 0)
1476 xor ((parity[SUBJ] xor integer(horiz[SUBJ] <> NH)) <> 0));
1477 tl := integer( ((parity[CLIP] xor integer(horiz[CLIP] <> NH) xor edge.bundle[BELOW][CLIP]) <> 0)
1478 xor ((parity[SUBJ] xor integer(horiz[SUBJ] <> NH) xor edge.bundle[BELOW][SUBJ]) <> 0));
1479 end;
1480
1481 GPC_UNION: begin
1482 contributing := integer( ((exists[CLIP] <> 0) and ((parity[SUBJ] = 0) or (horiz[SUBJ] <> NH)))
1483 or ((exists[SUBJ] <> 0) and ((parity[CLIP] = 0) or (horiz[CLIP] <> NH)))
1484 or ((exists[CLIP] <> 0) and (exists[SUBJ] <> 0) and (parity[CLIP] = parity[SUBJ])));
1485
1486 br := integer((parity[CLIP] <> 0) or (parity[SUBJ] <> 0));
1487 bl := integer( ((parity[CLIP] xor edge.bundle[ABOVE][CLIP]) <> 0)
1488 or ((parity[SUBJ] xor edge.bundle[ABOVE][SUBJ]) <> 0));
1489 tr := integer( ((parity[CLIP] xor integer(horiz[CLIP] <> NH)) <> 0)
1490 or ((parity[SUBJ] xor integer(horiz[SUBJ] <> NH)) <> 0));
1491 tl := integer( ((parity[CLIP] xor integer(horiz[CLIP] <> NH) xor edge.bundle[BELOW][CLIP]) <> 0)
1492 or ((parity[SUBJ] xor integer(horiz[SUBJ] <> NH) xor edge.bundle[BELOW][SUBJ]) <> 0));
1493 end;
1494 end; { case }
1495
1496 { Update parity }
1497 (* parity[CLIP] := integer((parity[CLIP] <> 0) xor (edge.bundle[ABOVE][CLIP] <> 0));
1498 parity[SUBJ] := integer((parity[SUBJ] <> 0) xor (edge.bundle[ABOVE][SUBJ] <> 0));
1499 *)
1500 parity[CLIP] := parity[CLIP] xor edge.bundle[ABOVE][CLIP];
1501 parity[SUBJ] := parity[SUBJ] xor edge.bundle[ABOVE][SUBJ];
1502
1503 { Update horizontal state }
1504 if exists[CLIP] <> 0 then
1505 horiz[CLIP] :=
1506 next_h_state[integer(horiz[CLIP])]
1507 [((exists[CLIP] - 1) shl 1) + parity[CLIP]];
1508 if exists[SUBJ] <> 0 then
1509 horiz[SUBJ] :=
1510 next_h_state[integer(horiz[SUBJ])]
1511 [((exists[SUBJ] - 1) shl 1) + parity[SUBJ]];
1512
1513 _class := tr + (tl shl 1) + (br shl 2) + (bl shl 3);
1514
1515 if contributing <> 0 then
1516 begin
1517 xb := edge.xb;
1518
1519 case Tvertex_type(_class) of
1520 EMN,
1521 IMN: begin
1522 add_local_min(@out_poly, edge, xb, yb);
1523 px := xb;
1524 cf := edge.outp[ABOVE];
1525 end;
1526 ERI: begin
1527 if NE(xb, px) then
1528 begin
1529 add_right(cf, xb, yb);
1530 px := xb;
1531 end;
1532 edge.outp[ABOVE] := cf;
1533 cf := nil;
1534 end;
1535 ELI: begin
1536 add_left(edge.outp[BELOW], xb, yb);
1537 px := xb;
1538 cf := edge.outp[BELOW];
1539 end;
1540 EMX: begin
1541 if NE(xb, px) then
1542 begin
1543 add_left(cf, xb, yb);
1544 px := xb;
1545 end;
1546 merge_right(cf, edge.outp[BELOW], out_poly);
1547 cf := nil;
1548 end;
1549 ILI: begin
1550 if NE(xb, px) then
1551 begin
1552 add_left(cf, xb, yb);
1553 px := xb;
1554 end;
1555 edge.outp[ABOVE] := cf;
1556 cf := nil;
1557 end;
1558 IRI: begin
1559 add_right(edge.outp[BELOW], xb, yb);
1560 px := xb;
1561 cf := edge.outp[BELOW];
1562 edge.outp[BELOW] := nil;
1563 end;
1564 IMX: begin
1565 if NE(xb, px) then
1566 begin
1567 add_right(cf, xb, yb);
1568 px := xb;
1569 end;
1570 merge_left(cf, edge.outp[BELOW], out_poly);
1571 cf := nil;
1572 edge.outp[BELOW] := nil;
1573 end;
1574 IMM: begin
1575 if NE(xb, px) then
1576 begin
1577 add_right(cf, xb, yb);
1578 px := xb;
1579 end;
1580 merge_left(cf, edge.outp[BELOW], out_poly);
1581 edge.outp[BELOW] := nil;
1582 add_local_min(@out_poly, edge, xb, yb);
1583 cf := edge.outp[ABOVE];
1584 end;
1585 EMM: begin
1586 if NE(xb, px) then
1587 begin
1588 add_left(cf, xb, yb);
1589 px := xb;
1590 end;
1591 merge_right(cf, edge.outp[BELOW], out_poly);
1592 edge.outp[BELOW] := nil;
1593 add_local_min(@out_poly, edge, xb, yb);
1594 cf := edge.outp[ABOVE];
1595 end;
1596 LED: begin
1597 if EQ(edge.bot.y, yb) then
1598 add_left(edge.outp[BELOW], xb, yb);
1599 edge.outp[ABOVE] := edge.outp[BELOW];
1600 px := xb;
1601 end;
1602 RED: begin
1603 if EQ(edge.bot.y, yb) then
1604 add_right(edge.outp[BELOW], xb, yb);
1605 edge.outp[ABOVE] := edge.outp[BELOW];
1606 px := xb;
1607 end;
1608 else
1609 end; { End of case }
1610 end; { End of contributing conditional }
1611 end; { End of edge exists conditional }
1612 edge := edge.next;
1613 end; { End of AET loop }
1614
1615 { Delete terminating edges from the AET, otherwise compute xt }
1616 edge := aet;
1617 while edge <> nil do
1618 begin
1619 if EQ(edge.top.y, yb) then
1620 begin
1621 prev_edge := edge.prev;
1622 next_edge := edge.next;
1623 if prev_edge <> nil then
1624 prev_edge.next := next_edge
1625 else
1626 aet := next_edge;
1627 if next_edge <> nil then
1628 next_edge.prev := prev_edge;
1629
1630 { Copy bundle head state to the adjacent tail edge if required }
1631 if (edge.bstate[BELOW] = BUNDLE_HEAD) and (prev_edge <> nil) then
1632 begin
1633 if prev_edge.bstate[BELOW] = BUNDLE_TAIL then
1634 begin
1635 prev_edge.outp[BELOW] := edge.outp[BELOW];
1636 prev_edge.bstate[BELOW] := UNBUNDLED;
1637 if prev_edge.prev <> nil then
1638 if prev_edge.prev.bstate[BELOW] = BUNDLE_TAIL then
1639 prev_edge.bstate[BELOW] := BUNDLE_HEAD;
1640 end;
1641 end;
1642 end
1643 else
1644 begin
1645 if EQ(edge.top.y, yt) then
1646 edge.xt := edge.top.x
1647 else
1648 edge.xt := edge.bot.x + edge.dx * (yt - edge.bot.y);
1649 end;
1650
1651 edge := edge.next;
1652 end;
1653
1654 if scanbeam < sbt_entries then
1655 begin
1656 { === SCANBEAM INTERIOR PROCESSING ============================== }
1657
1658 build_intersection_table(it, aet, dy);
1659
1660 { Process each node in the intersection table }
1661 intersect := it;
1662 while intersect <> nil do
1663 begin
1664 e0 := intersect.ie[0];
1665 e1 := intersect.ie[1];
1666
1667 { Only generate output for contributing intersections }
1668 if ((e0.bundle[ABOVE][CLIP] <> 0) or (e0.bundle[ABOVE][SUBJ] <> 0))
1669 and ((e1.bundle[ABOVE][CLIP] <> 0) or (e1.bundle[ABOVE][SUBJ] <> 0)) then
1670 begin
1671 P := e0.outp[ABOVE];
1672 Q := e1.outp[ABOVE];
1673 ix := intersect.point.x;
1674 iy := intersect.point.y + yb;
1675
1676 inn[CLIP] := integer( ((e0.bundle[ABOVE][CLIP] <> 0) and (e0.bside[CLIP] = 0))
1677 or ((e1.bundle[ABOVE][CLIP] <> 0) and (e1.bside[CLIP] <> 0))
1678 or ((e0.bundle[ABOVE][CLIP] = 0) and (e1.bundle[ABOVE][CLIP] = 0)
1679 and (e0.bside[CLIP] <> 0) and (e1.bside[CLIP] <> 0)));
1680
1681 inn[SUBJ] := integer( ((e0.bundle[ABOVE][SUBJ] <> 0) and (e0.bside[SUBJ] = 0))
1682 or ((e1.bundle[ABOVE][SUBJ] <> 0) and (e1.bside[SUBJ] <> 0))
1683 or ((e0.bundle[ABOVE][SUBJ] = 0) and (e1.bundle[ABOVE][SUBJ] = 0)
1684 and (e0.bside[SUBJ] <> 0) and (e1.bside[SUBJ] <> 0)));
1685
1686 { Determine quadrant occupancies }
1687 case set_operation of
1688
1689 GPC_DIFF,
1690 GPC_INT: begin
1691 tr := integer((inn[CLIP] <> 0) and (inn[SUBJ] <> 0));
1692 tl := integer( ((inn[CLIP] xor e1.bundle[ABOVE][CLIP]) <> 0)
1693 and ((inn[SUBJ] xor e1.bundle[ABOVE][SUBJ]) <> 0));
1694 br := integer( ((inn[CLIP] xor e0.bundle[ABOVE][CLIP]) <> 0)
1695 and ((inn[SUBJ] xor e0.bundle[ABOVE][SUBJ]) <> 0));
1696 bl := integer( ((inn[CLIP] xor e1.bundle[ABOVE][CLIP] xor e0.bundle[ABOVE][CLIP]) <> 0)
1697 and ((inn[SUBJ] xor e1.bundle[ABOVE][SUBJ] xor e0.bundle[ABOVE][SUBJ]) <> 0));
1698 end;
1699
1700 GPC_XOR: begin
1701 tr := integer((inn[CLIP] <> 0) xor (inn[SUBJ] <> 0));
1702 tl := integer( (inn[CLIP] xor e1.bundle[ABOVE][CLIP])
1703 xor (inn[SUBJ] xor e1.bundle[ABOVE][SUBJ]));
1704 br := integer( (inn[CLIP] xor e0.bundle[ABOVE][CLIP])
1705 xor (inn[SUBJ] xor e0.bundle[ABOVE][SUBJ]));
1706 bl := integer( (inn[CLIP] xor e1.bundle[ABOVE][CLIP] xor e0.bundle[ABOVE][CLIP])
1707 xor (inn[SUBJ] xor e1.bundle[ABOVE][SUBJ] xor e0.bundle[ABOVE][SUBJ]));
1708 end;
1709
1710 GPC_UNION: begin
1711 tr := integer((inn[CLIP] <> 0) or (inn[SUBJ] <> 0));
1712 tl := integer( ((inn[CLIP] xor e1.bundle[ABOVE][CLIP]) <> 0)
1713 or ((inn[SUBJ] xor e1.bundle[ABOVE][SUBJ]) <> 0));
1714 br := integer( ((inn[CLIP] xor e0.bundle[ABOVE][CLIP]) <> 0)
1715 or ((inn[SUBJ] xor e0.bundle[ABOVE][SUBJ]) <> 0));
1716 bl := integer( ((inn[CLIP] xor e1.bundle[ABOVE][CLIP] xor e0.bundle[ABOVE][CLIP]) <> 0)
1717 or ((inn[SUBJ] xor e1.bundle[ABOVE][SUBJ] xor e0.bundle[ABOVE][SUBJ]) <> 0));
1718 end;
1719 end; { case }
1720
1721 _class := tr + (tl shl 1) + (br shl 2) + (bl shl 3);
1722
1723 case Tvertex_type(_class) of
1724 EMN: begin
1725 add_local_min(@out_poly, e0, ix, iy);
1726 e1.outp[ABOVE] := e0.outp[ABOVE];
1727 end;
1728 ERI: begin
1729 if P <> nil then
1730 begin
1731 add_right(P, ix, iy);
1732 e1.outp[ABOVE] := P;
1733 e0.outp[ABOVE] := nil;
1734 end;
1735 end;
1736 ELI: begin
1737 if Q <> nil then
1738 begin
1739 add_left(Q, ix, iy);
1740 e0.outp[ABOVE] := Q;
1741 e1.outp[ABOVE] := nil;
1742 end;
1743 end;
1744 EMX: begin
1745 if (P <> nil) and (Q <> nil) then
1746 begin
1747 add_left(P, ix, iy);
1748 merge_right(P, Q, out_poly);
1749 e0.outp[ABOVE] := nil;
1750 e1.outp[ABOVE] := nil;
1751 end;
1752 end;
1753 IMN: begin
1754 add_local_min(@out_poly, e0, ix, iy);
1755 e1.outp[ABOVE] := e0.outp[ABOVE];
1756 end;
1757 ILI: begin
1758 if P <> nil then
1759 begin
1760 add_left(P, ix, iy);
1761 e1.outp[ABOVE] := P;
1762 e0.outp[ABOVE] := nil;
1763 end;
1764 end;
1765 IRI: begin
1766 if Q <> nil then
1767 begin
1768 add_right(Q, ix, iy);
1769 e0.outp[ABOVE] := Q;
1770 e1.outp[ABOVE] := nil;
1771 end;
1772 end;
1773 IMX: begin
1774 if (P <> nil) and (Q <> nil) then
1775 begin
1776 add_right(P, ix, iy);
1777 merge_left(P, Q, out_poly);
1778 e0.outp[ABOVE] := nil;
1779 e1.outp[ABOVE] := nil;
1780 end;
1781 end;
1782 IMM: begin
1783 if (P <> nil) and (Q <> nil) then
1784 begin
1785 add_right(P, ix, iy);
1786 merge_left(P, Q, out_poly);
1787 add_local_min(@out_poly, e0, ix, iy);
1788 e1.outp[ABOVE] := e0.outp[ABOVE];
1789 end;
1790 end;
1791 EMM: begin
1792 if (P <> nil) and (Q <> nil) then
1793 begin
1794 add_left(P, ix, iy);
1795 merge_right(P, Q, out_poly);
1796 add_local_min(@out_poly, e0, ix, iy);
1797 e1.outp[ABOVE] := e0.outp[ABOVE];
1798 end;
1799 end;
1800 else
1801 end; { End of case }
1802 end; { End of contributing intersection conditional }
1803
1804 { Swap bundle sides in response to edge crossing }
1805 if (e0.bundle[ABOVE][CLIP] <> 0) then
1806 e1.bside[CLIP] := integer(e1.bside[CLIP] = 0);
1807 if (e1.bundle[ABOVE][CLIP] <> 0) then
1808 e0.bside[CLIP] := integer(e0.bside[CLIP] = 0);
1809 if (e0.bundle[ABOVE][SUBJ] <> 0) then
1810 e1.bside[SUBJ] := integer(e1.bside[SUBJ] = 0);
1811 if (e1.bundle[ABOVE][SUBJ] <> 0) then
1812 e0.bside[SUBJ] := integer(e0.bside[SUBJ] = 0);
1813
1814 { Swap e0 and e1 bundles in the AET }
1815 prev_edge := e0.prev;
1816 next_edge := e1.next;
1817 if next_edge <> nil then
1818 next_edge.prev := e0;
1819
1820 if e0.bstate[ABOVE] = BUNDLE_HEAD then
1821 begin
1822 search := FTRUE;
1823 while search <> 0 do
1824 begin
1825 prev_edge := prev_edge.prev;
1826 if prev_edge <> nil then
1827 begin
1828 if prev_edge.bstate[ABOVE] <> BUNDLE_TAIL then
1829 search := FFALSE;
1830 end
1831 else
1832 search := FFALSE;
1833 end;
1834 end;
1835 if prev_edge = nil then
1836 begin
1837 aet.prev := e1;
1838 e1.next := aet;
1839 aet := e0.next;
1840 end
1841 else
1842 begin
1843 prev_edge.next.prev := e1;
1844 e1.next := prev_edge.next;
1845 prev_edge.next := e0.next;
1846 end;
1847 e0.next.prev := prev_edge;
1848 e1.next.prev := e1;
1849 e0.next := next_edge;
1850
1851 intersect := intersect.next;
1852 end; { End of IT loop}
1853
1854 { Prepare for next scanbeam }
1855 edge := aet;
1856 while edge <> nil do
1857 begin
1858 next_edge := edge.next;
1859 succ_edge := edge.succ;
1860
1861 if EQ(edge.top.y, yt) and (succ_edge <> nil) then
1862 begin
1863 { Replace AET edge by its successor }
1864 succ_edge.outp[BELOW] := edge.outp[ABOVE];
1865 succ_edge.bstate[BELOW] := edge.bstate[ABOVE];
1866 succ_edge.bundle[BELOW][CLIP] := edge.bundle[ABOVE][CLIP];
1867 succ_edge.bundle[BELOW][SUBJ] := edge.bundle[ABOVE][SUBJ];
1868 prev_edge := edge.prev;
1869 if prev_edge <> nil then
1870 prev_edge.next := succ_edge
1871 else
1872 aet := succ_edge;
1873 if next_edge <> nil then
1874 next_edge.prev := succ_edge;
1875 succ_edge.prev := prev_edge;
1876 succ_edge.next := next_edge;
1877 end
1878 else
1879 begin
1880 { Update this edge }
1881 edge.outp[BELOW] := edge.outp[ABOVE];
1882 edge.bstate[BELOW] := edge.bstate[ABOVE];
1883 edge.bundle[BELOW][CLIP] := edge.bundle[ABOVE][CLIP];
1884 edge.bundle[BELOW][SUBJ] := edge.bundle[ABOVE][SUBJ];
1885 edge.xb := edge.xt;
1886 end;
1887 edge.outp[ABOVE] := nil;
1888 edge := next_edge;
1889 end;
1890 end;
1891 end; { === END OF SCANBEAM PROCESSING ================================== }
1892
1893 { Generate result polygon from out_poly }
1894 result_polygon.contour := nil;
1895 result_polygon.num_contours := count_contours(out_poly);
1896 if result_polygon.num_contours > 0 then
1897 begin
1898 MALLOC(pointer(result_polygon.hole), result_polygon.num_contours
1899 * sizeof(Integer), 'hole flag table creation');
1900 MALLOC(pointer(result_polygon.contour), result_polygon.num_contours
1901 * sizeof(Tgpc_vertex_list), 'contour creation');
1902 poly := out_poly;
1903 c := 0;
1904
1905 while poly <> nil do
1906 begin
1907 npoly := poly.next;
1908 if poly.active <> 0 then
1909 begin
1910 result_polygon.hole[c] := poly.proxy.hole;
1911 result_polygon.contour[c].num_vertices := poly.active;
1912 MALLOC(pointer(result_polygon.contour[c].vertex),
1913 result_polygon.contour[c].num_vertices * sizeof(Tgpc_vertex),
1914 'vertex creation');
1915
1916 v := result_polygon.contour[c].num_vertices - 1;
1917 vtx := poly.proxy.v[LEFT];
1918 while vtx <> nil do
1919 begin
1920 nv := vtx.next;
1921 result_polygon.contour[c].vertex[v].x := vtx.x;
1922 result_polygon.contour[c].vertex[v].y := vtx.y;
1923 FREE(pointer(vtx));
1924 Dec(v);
1925 vtx := nv;
1926 end;
1927 Inc(c);
1928 end;
1929 FREE(pointer(poly));
1930 poly := npoly;
1931 end;
1932 end;
1933
1934 { Tidy up }
1935 reset_it(it);
1936 reset_lmt(lmt);
1937 FREE(pointer(c_heap));
1938 FREE(pointer(s_heap));
1939 FREE(pointer(sbt));
1940 end;
1941
1942
1943 procedure gpc_free_tristrip(tristrip : Pgpc_tristrip);
1944 var
1945 s : integer;
1946 begin
1947 for s := 0 to tristrip.num_strips - 1 do
1948 CFREE(pointer(tristrip.strip[s].vertex));
1949 CFREE(pointer(tristrip.strip));
1950 tristrip.num_strips := 0;
1951 end;
1952
1953
1954
1955
1956
1957
1958
1959 //===========================================================================
1960 // End of file: gpc.pas
1961 //===========================================================================
1962
1963
1964 end.
1965
1966