* DrawPoly and FillPoly TP7 compatibility fixes

git-svn-id: trunk@15869 -
This commit is contained in:
nickysn 2010-08-21 21:18:23 +00:00
parent b30c284b08
commit dabb5be491
6 changed files with 941 additions and 8 deletions

3
.gitattributes vendored
View File

@ -2627,6 +2627,9 @@ packages/graph/src/unix/graph16.inc svneol=native#text/plain
packages/graph/src/win32/graph.pp svneol=native#text/plain
packages/graph/src/win32/wincrt.pp svneol=native#text/plain
packages/graph/src/win32/winmouse.pp svneol=native#text/plain
packages/graph/tests/polytest.pas svneol=native#text/plain
packages/graph/tests/polytest.txt svneol=native#text/plain
packages/graph/tests/polytst2.txt svneol=native#text/plain
packages/gtk1/Makefile svneol=native#text/plain
packages/gtk1/Makefile.fpc svneol=native#text/plain
packages/gtk1/README.txt svneol=native#text/plain

View File

@ -57,6 +57,8 @@ var
ptable : ^pointtype;
LastPolygonStart : Longint;
Closing, PrevClosing : Boolean;
begin
{ /********************************************************************
@ -74,12 +76,34 @@ begin
{ check for getmem success }
nEdges := 0;
LastPolygonStart := 0;
Closing := false;
for i := 0 to (numpoints-1) do begin
p0 := ptable[i];
if (i+1) >= numpoints then p1 := ptable[0]
else p1 := ptable[i+1];
{ save the 'closing' flag for the previous edge }
PrevClosing := Closing;
{ check if the current edge is 'closing'. This means that it 'closes'
the polygon by going back to the first point of the polygon.
Also, 0-length edges are never considered 'closing'. }
if ((p1.x <> ptable[i].x) or
(p1.y <> ptable[i].y)) and
(LastPolygonStart < i) and
((p1.x = ptable[LastPolygonStart].x) and
(p1.y = ptable[LastPolygonStart].y)) then
begin
Closing := true;
LastPolygonStart := i + 2;
end
else
Closing := false;
{ skip current edge if the previous edge was 'closing'. This is TP7 compatible }
if PrevClosing then
continue;
{ draw the edges }
Line(p0.x,p0.y,p1.x,p1.y);
{ nickysn: moved after drawing the filled area
Line(p0.x,p0.y,p1.x,p1.y);}
{ ignore if this is a horizontal edge}
if (p0.y = p1.y) then continue;
{ swap ptable if necessary to ensure p0 contains yMin}
@ -167,7 +191,7 @@ begin
{ Fill in desired pixels values on scan line y by using pairs of x
coordinates from the AET }
i := 0;
while (i < nActive) do begin
while (i < (nActive - 1)) do begin
x0 := AET^[i]^.x;
x1 := AET^[i+1]^.x;
{Left edge adjustment for positive fraction. 0 is interior. }
@ -209,6 +233,37 @@ begin
inc(y);
if (y >= ViewHeight) then break;
end;
{ finally, draw the edges }
LastPolygonStart := 0;
Closing := false;
for i := 0 to (numpoints-1) do begin
p0 := ptable[i];
if (i+1) >= numpoints then p1 := ptable[0]
else p1 := ptable[i+1];
{ save the 'closing' flag for the previous edge }
PrevClosing := Closing;
{ check if the current edge is 'closing'. This means that it 'closes'
the polygon by going back to the first point of the polygon.
Also, 0-length edges are never considered 'closing'. }
if ((p1.x <> p0.x) or
(p1.y <> p0.y)) and
(LastPolygonStart < i) and
((p1.x = ptable[LastPolygonStart].x) and
(p1.y = ptable[LastPolygonStart].y)) then
begin
Closing := true;
LastPolygonStart := i + 2;
end
else
Closing := false;
{ skip edge if the previous edge was 'closing'. This is TP7 compatible }
if PrevClosing then
continue;
{ draw the edges }
Line(p0.x,p0.y,p1.x,p1.y);
end;
System.freemem(et, sizeof(tedge) * numpoints);
System.freemem(get, sizeof(pedge) * numpoints);
System.freemem(aet, sizeof(pedge) * numpoints);

View File

@ -1871,18 +1871,41 @@ end;
ppointtype = ^pointtype;
pt = array[0..16000] of pointtype;
var
i : longint;
i, j, LastPolygonStart: longint;
Closing: boolean;
begin
if numpoints < 2 then
begin
_GraphResult := grError;
{ nickysn: TP7 doesn't return error here }
{_GraphResult := grError;}
exit;
end;
Closing := false;
LastPolygonStart := 0;
for i:=0 to numpoints-2 do
line(pt(polypoints)[i].x,
pt(polypoints)[i].y,
pt(polypoints)[i+1].x,
pt(polypoints)[i+1].y);
begin
{ skip an edge after each 'closing' edge }
if not Closing then
line(pt(polypoints)[i].x,
pt(polypoints)[i].y,
pt(polypoints)[i+1].x,
pt(polypoints)[i+1].y);
{ check if the current edge is 'closing'. This means that it 'closes'
the polygon by going back to the first point of the polygon.
Also, 0-length edges are never considered 'closing'. }
if ((pt(polypoints)[i+1].x <> pt(polypoints)[i].x) or
(pt(polypoints)[i+1].y <> pt(polypoints)[i].y)) and
(LastPolygonStart < i) and
((pt(polypoints)[i+1].x = pt(polypoints)[LastPolygonStart].x) and
(pt(polypoints)[i+1].y = pt(polypoints)[LastPolygonStart].y)) then
begin
Closing := true;
LastPolygonStart := i + 2;
end
else
Closing := false;
end;
end;

View File

@ -0,0 +1,83 @@
{
test for graph unit's DrawPoly and FillPoly procedures
compiles with Turbo Pascal 7 and Free Pascal
used for TP7 compatibily testing
}
program PolyTest;
uses
graph;
const
MaxPoints = 1000;
var
InF: Text;
NumPoints: Integer;
Poly: array [1..MaxPoints] of PointType;
procedure ReadPoly;
var
I: Integer;
begin
Readln(InF, NumPoints);
for I := 1 to NumPoints do
Readln(InF, Poly[I].X, Poly[I].Y);
end;
procedure CheckGraphResult;
var
ErrorCode: Integer;
begin
ErrorCode := GraphResult;
if ErrorCode <> grOk then
begin
CloseGraph;
Writeln(ErrorCode, ': ', GraphErrorMsg(ErrorCode));
Readln;
Halt(1);
end;
end;
procedure Tralala;
var
I: Integer;
IStr: string;
begin
if ParamStr(1) <> '' then
Assign(InF, ParamStr(1))
else
Assign(InF, 'polytest.txt');
Reset(InF);
I := 1;
while not Eof(InF) do
begin
ReadPoly;
ClearDevice;
Str(I, IStr);
OutTextXY(0, 0, IStr);
DrawPoly(NumPoints, Poly);
CheckGraphResult;
Readln;
ClearDevice;
OutTextXY(0, 0, IStr + ' fill');
FillPoly(NumPoints, Poly);
CheckGraphResult;
Readln;
Inc(I);
end;
Close(InF);
end;
var
GraphDriver, GraphMode: Integer;
begin
GraphDriver := VGA;
GraphMode := VGAHi;
InitGraph(GraphDriver, GraphMode, '');
SetFillStyle(SolidFill, 9);
Tralala;
CloseGraph;
end.

View File

@ -0,0 +1,89 @@
0
1
320 240
2
310 240
330 240
2
320 230
320 250
4
325 250
320 240
330 240
325 250
5
325 250
320 240
330 240
325 250
330 260
5
325 250
320 240
330 240
326 250
330 260
6
325 250
320 240
330 240
325 250
330 260
320 260
7
325 250
320 240
330 240
325 250
330 260
320 260
325 250
8
325 250
320 240
330 240
325 250
325 250
330 260
320 260
325 250
9
325 250
320 240
330 240
325 250
325 250
325 250
330 260
320 260
325 250
12
300 200
310 200
300 210
300 200
350 250
360 250
350 260
350 250
355 200
370 210
360 250
370 250
6
300 250
325 250
320 240
330 240
325 250
330 260
3
320 200
320 200
330 200
4
320 200
320 200
320 200
330 200

View File

@ -0,0 +1,680 @@
679
351 284
457 405
385 411
348 406
271 299
413 184
280 142
570 27
616 130
245 229
506 389
338 230
363 188
592 401
45 161
55 311
12 176
532 459
498 67
556 417
626 227
511 384
295 249
499 325
75 345
409 279
91 257
604 364
333 50
265 227
169 89
495 353
291 103
363 64
12 155
395 71
391 106
394 185
603 433
436 215
230 294
279 433
446 47
38 465
426 313
429 82
134 171
82 360
201 291
232 156
364 18
280 304
632 460
65 313
133 304
103 477
417 279
162 198
298 227
156 299
101 162
70 323
420 152
88 373
125 455
235 318
525 6
62 298
536 323
61 466
624 421
299 244
625 26
387 216
473 9
25 212
180 470
76 172
189 230
75 330
203 422
265 440
41 104
443 271
362 415
169 244
334 440
60 442
368 39
594 133
203 4
427 404
84 310
458 403
185 127
117 190
375 265
12 79
530 177
3 70
433 273
172 337
470 138
615 207
159 362
368 190
378 430
366 306
142 427
609 326
286 215
541 469
447 55
190 368
520 197
253 324
563 119
372 150
564 463
443 282
464 316
320 255
611 110
412 189
271 297
388 227
12 225
193 343
422 138
185 184
395 359
274 421
86 49
190 44
364 169
378 264
367 16
418 465
417 154
276 106
573 67
235 46
278 472
570 124
515 257
450 215
64 47
588 169
457 225
639 403
95 434
555 18
103 243
393 80
79 373
542 415
516 197
364 67
260 15
44 471
446 179
290 201
462 24
554 175
624 7
547 110
7 367
230 453
467 359
109 162
333 234
34 162
127 86
11 82
507 222
143 419
221 453
593 291
450 286
20 376
105 240
397 24
369 335
152 476
597 128
392 325
342 414
377 360
467 462
199 266
254 101
134 106
119 104
604 273
473 217
313 465
145 326
162 40
37 27
278 234
199 422
445 468
241 296
114 260
15 410
43 357
434 229
290 324
343 291
573 343
633 225
138 218
424 435
168 65
13 110
485 423
204 434
245 309
376 155
531 249
402 0
558 149
175 204
510 424
118 326
609 218
439 232
137 378
606 110
467 422
162 150
136 459
331 226
16 341
132 73
271 350
239 310
296 103
177 89
375 387
552 358
75 323
331 132
84 83
458 338
253 222
361 403
117 98
92 79
312 59
227 346
601 14
489 358
479 44
578 104
53 359
353 351
374 21
615 100
186 137
154 325
64 30
10 266
594 4
428 399
502 472
180 337
375 87
40 245
310 278
625 378
560 291
216 104
615 218
148 421
607 236
602 343
511 233
403 340
559 239
187 405
543 93
395 371
8 467
222 413
94 374
628 472
306 361
318 1
409 129
235 197
87 205
526 142
121 192
327 57
143 470
62 194
551 273
622 164
614 378
580 197
495 172
213 191
51 144
260 372
148 444
84 156
34 457
464 6
7 256
493 146
94 423
50 120
57 325
430 389
157 207
269 361
356 398
550 181
465 46
173 122
84 284
35 228
193 234
167 220
291 251
437 212
445 409
181 208
243 396
115 244
504 41
36 316
446 99
498 406
497 327
166 85
239 33
376 4
174 428
237 64
126 374
294 444
28 343
511 235
49 225
332 423
196 234
369 198
614 83
413 228
22 376
275 267
326 76
343 69
436 311
177 258
82 156
251 70
612 76
119 62
578 277
348 44
292 437
564 39
293 384
463 421
255 44
578 204
441 227
447 278
209 343
484 12
407 351
153 368
102 4
509 147
613 111
293 241
378 457
548 267
292 46
609 298
368 414
525 75
581 476
521 40
102 45
402 304
254 455
40 449
271 214
165 349
543 356
21 147
613 57
227 213
228 188
10 255
118 405
256 257
594 326
63 292
604 47
556 44
290 26
209 41
148 113
393 402
21 250
9 246
274 311
43 261
161 15
141 278
162 370
83 180
7 235
73 471
395 117
623 179
633 21
261 148
104 399
408 387
313 307
633 176
41 150
501 384
184 33
154 328
424 182
157 304
426 444
331 409
271 238
355 205
183 394
452 354
265 214
230 465
530 174
591 190
29 354
148 215
223 449
521 123
630 183
620 334
579 430
189 58
634 115
159 109
67 234
608 427
149 171
441 184
37 440
467 54
564 302
174 63
242 179
239 155
479 326
152 381
109 241
287 142
194 425
537 168
152 354
321 266
603 96
405 263
555 249
601 167
480 11
447 71
619 63
636 339
289 340
45 293
187 322
97 214
267 334
84 181
386 48
244 460
573 34
619 9
350 470
175 71
379 124
573 103
260 278
353 468
173 131
291 465
257 12
158 426
323 340
198 133
238 429
335 12
480 300
213 158
591 464
551 80
31 432
162 158
285 426
66 245
223 245
473 185
435 254
398 453
454 428
131 325
218 306
432 263
562 130
347 71
180 411
19 304
454 143
5 220
238 11
339 267
590 173
57 241
259 73
15 204
219 434
398 4
178 465
134 331
74 47
369 139
444 258
430 347
607 186
1 109
414 218
384 466
376 400
616 439
10 320
445 211
520 328
326 311
213 13
506 441
62 260
282 475
332 183
444 387
58 221
145 396
262 258
398 425
567 422
396 157
85 194
627 261
557 298
321 182
590 260
346 58
590 326
531 137
619 20
588 55
23 51
111 151
249 118
609 270
192 435
102 278
567 287
285 114
581 278
102 70
423 161
281 300
48 173
445 437
158 421
25 208
38 248
39 227
580 88
473 208
574 90
430 343
338 251
194 153
638 1
231 286
301 311
242 2
626 465
111 318
209 140
435 96
40 444
388 148
305 193
181 303
152 427
329 207
235 445
292 284
215 207
621 284
85 170
61 315
219 313
378 394
421 193
254 18
639 472
225 215
461 450
408 322
520 128
624 270
569 459
489 54
446 130
214 39
94 367
40 10
154 65
276 125
334 418
494 86
613 207
75 156
68 280
377 449
477 451
542 25
598 286
629 428
255 374
243 101
94 367
438 90
420 431
551 4
62 43
318 297
371 183
154 46
108 472
550 430
37 130
301 227
74 230
292 244
627 464
271 47
548 19
75 232
173 219
258 112
255 28
429 59
220 411
456 191
409 183
255 10
276 179
393 317
44 300
526 438
418 322
464 155
343 151
70 399