home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The World of Computer Software
/
World_Of_Computer_Software-02-386-Vol-2of3.iso
/
b
/
bgi256-3.zip
/
FLOODTST.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1992-12-28
|
11KB
|
383 lines
{How good is your floodfill routine?}
{Can it survive this obstical course?}
{This program generates a worst case pattern for floodfill}
{then calls the floodfill routine to fill the pattern.}
{A badly implemented floodfill will blowup}
{a poorly implemented floodfill will leave holes}
{a typical floodfill will run out of memory and give up }
{ part way through filling the pattern.}
{A fantastic floodfill will fill the whole pattern.}
{Also notice the little color squares at the top or left of the pattern}
{ this shows the type of floodfill you have. If the colors get }
{ overwritten, then you have a border bound floodfill.}
{ If the color squares remain intact, then you have a}
{ seed bound flood fill.}
{ The floodfill should leak out of the hole in the upper left corner}
{ of the inner rectangle, and should be clipped to the middle area}
{ between the two rectangles. If the floodfill fills the entire}
{ area between the inner and outer rectangles, then it is not}
{ clipping correctly to the viewport.
{If the floodfill does not fill the entire pattern and leaves holes}
{ in the areas to be filled, it means that the floodfill does not}
{ fail gracefully. A good floodfill recognizes that it may run out of}
{ memory and will backup filling what it can on the way back.}
{ a poor floodfill will bomb out and leave holes all over the place.}
{Can your floodfill handle patterns? Can it deal with the edge of the}
{ screen? The area outside the test rectangle should be filled with}
{ a blue crosshatch if the floodfill is working correctly.}
{Finally, if everything went right, the GraphResult printed at the}
{bottom of the screen in yellow should show a value of zero.}
{If you got an error because you ran out of memory, it should say that}
PROGRAM FloodTst;
uses crt,graph,WrMode;
var gd,gm,mm:integer;
imagearray:array[0..1000] of byte;
RESULT,error:integer;
s,ModeName:string;
StartMode : integer;
function fstr(i:integer):string;
var s:string;
begin
str(i,s);
fstr := s;
end;
{$F+}
function AutoDet:integer;
begin
AutoDet := StartMode;
end;
{$F-}
procedure FillPatternHorz(Bx,By,Sx,Sy:integer);
var ix,iy,xp,yp,xs,ys:integer;
begin
setviewport(0,0,GetMaxX,GetMaxY,true);
xs := ((Sx-40) div 8);
ys := ((Sy-70) div 6);
setcolor(white);
rectangle(Bx+0,By+0,Bx+(xs*8)+25,By+(ys*6)+26);
rectangle(Bx+8,By+8,Bx+(xs*8)+17,By+(ys*6)+18);
putpixel(Bx+8,By+10,black);
OutTextXY(Bx,By+(ys*6)+28,'Horizontal flood test');
for ix := 1 to pred(xs) do
begin
setfillstyle(1,ix);
bar(Bx+(ix*8)+11,By+11,Bx+(ix*8)+13,By+13);
end;
for iy := 1 to ys do
begin
for ix := 1 to xs do
begin
xp := Bx+(ix*8);
yp := By+8+(iy*6);
line(xp,yp,xp+4,yp+4);
line(xp+4,yp+4,xp+8,yp);
line(xp+8,yp+3,xp+12,yp+7);
line(xp+12,yp+7,xp+16,yp+3);
end;
end;
setviewport(Bx+5,By+5,Bx+(xs*8)+20,By+(ys*6)+21,true);
setcolor(red);
setfillstyle(SolidFill,2);
{ putpixel(7,15,red); putpixel(7,17,red); putpixel(6,16,red); putpixel(8,16,red); }
floodfill(7,16,white)
end;
procedure FillPatternVert(Bx,By,Sx,Sy:integer);
var ix,iy,xp,yp,xs,ys:integer;
begin
setviewport(0,0,GetMaxX,GetMaxY,true);
xs := ((Sx-50) div 6);
ys := ((Sy-60) div 8);
setcolor(white);
rectangle(Bx+0,By+0,Bx+(xs*6)+28,By+(ys*8)+21);
rectangle(Bx+8,By+8,Bx+(xs*6)+20,By+(ys*8)+13);
putpixel(Bx+8,By+10,black);
OutTextXY(Bx,By+(ys*8)+23,'Vertical flood test');
for iy := 1 to pred(ys) do
begin
setfillstyle(1,iy);
bar(Bx+11,By+(iy*8)+11,Bx+13,By+(iy*8)+13);
end;
for iy := 1 to ys do
begin
for ix := 1 to xs do
begin
xp := Bx+(ix*6)+10;
yp := By+(iy*8);
line(xp,yp,xp+4,yp+4);
line(xp+4,yp+4,xp,yp+8);
line(xp+3,yp+8,xp+7,yp+12);
line(xp+6,yp+5,xp+4,yp+7);
end;
end;
setviewport(Bx+5,By+5,Bx+(xs*6)+23,By+(ys*8)+16,true);
setcolor(red);
setfillstyle(SolidFill,2);
{ putpixel(17,5,red); putpixel(17,7,red); putpixel(16,6,red); putpixel(18,6,red); }
floodfill(17,6,white)
end;
procedure FillPatternSpiral(Bx,By,Sx,Sy:integer);
var ix,iy,xp,yp,xs,ys:integer;
begin
setviewport(0,0,GetMaxX,GetMaxY,true);
xs := ((Sx-40) div 4);
ys := ((Sy-70) div 4);
setcolor(white);
rectangle(Bx+0,By+0,Bx+(xs*4)+25,By+(ys*4)+26);
rectangle(Bx+8,By+8,Bx+(xs*4)+17,By+(ys*4)+18);
putpixel(Bx+8,By+10,black);
OutTextXY(Bx,By+(ys*4)+28,'Spiral flood test'{ x:'+fstr(xs)+' y:'+fstr(ys)});
moveto(Bx+((xs*4)div 2)+8,By+((ys*4) div 2)+12);
ix := 2;
yp := (((ys*4)+10) div 4) -1;
for iy := 0 to yp do
begin
linerel(ix,0);
linerel(0,ix);
inc(ix,2);
linerel(-ix,0);
linerel(0,-ix);
inc(ix,2);
end;
for iy := 1 to pred(ys) do
begin
setfillstyle(1,iy);
bar(Bx+11,By+(iy*4)+11,Bx+13,By+(iy*4)+13);
end;
setviewport(Bx+5,By+5,Bx+(xs*4)+20,By+(ys*4)+21,true);
setcolor(red);
setfillstyle(SolidFill,2);
xs := (xs*4);
{ putpixel(xs,5,red); putpixel(xs,7,red); putpixel(xs-1,6,red); putpixel(xs+1,6,red); }
floodfill(xs,6,white)
end;
procedure FillPatternGrill(Bx,By,Sx,Sy:integer);
var ix,iy,xp,yp,xs,ys:integer;
begin
setviewport(0,0,GetMaxX,GetMaxY,true);
xs := ((Sx-40) div 4);
ys := ((Sy-70) div 4);
setcolor(white);
rectangle(Bx+0,By+0,Bx+(xs*4)+25,By+(ys*4)+26);
rectangle(Bx+8,By+8,Bx+(xs*4)+17,By+(ys*4)+18);
putpixel(Bx+8,By+10,0);
OutTextXY(Bx,By+(ys*4)+28,'Grill flood test'{ x:'+fstr(xs)+' y:'+fstr(ys)});
{ moveto(Bx+((xs*4)div 2)+8,By+((ys*4) div 2)+12); }
ix := Bx+20;
iy := By+10;
yp := (((ys*4)+10) div 4);
line(ix,iy+(ys*2),ix+(xs*4)-8,iy+(ys*2));
for xp := 0 to (xs-2)*2 do
begin
line(ix+(xp*2),iy,ix+(xp*2),iy+(ys*4)+6);
end;
for iy := 1 to ys do
begin
setfillstyle(1,iy);
bar(Bx+11,By+(iy*4)+11,Bx+13,By+(iy*4)+13);
end;
setviewport(Bx+5,By+5,Bx+(xs*4)+20,By+(ys*4)+21,true);
setcolor(red);
setfillstyle(SolidFill,2);
xs := (xs*4);
{ putpixel(16,15,red); putpixel(16,17,red); putpixel(15,16,red); putpixel(17,16,red); }
floodfill(16,16,white)
end;
procedure FillPatternCircle(Bx,By,Sx,Sy:integer);
var r,ix,iy,xp,yp,xs,ys,xf,yf,pat:integer;
mc,spz,rx,ry:word;
a : array[0..1000] of pointtype;
begin
setviewport(0,0,GetMaxX,GetMaxY,true);
xs := ((Sx-40) div 4);
ys := ((Sy-70) div 4);
setcolor(white);
rectangle(Bx+0,By+0,Bx+(xs*4)+25,By+(ys*4)+26);
rectangle(Bx+8,By+8,Bx+(xs*4)+17,By+(ys*4)+18);
putpixel(Bx+8,By+10,0);
OutTextXY(Bx,By+(ys*4)+28,'Circle flood test'{ x:'+fstr(xs)+' y:'+fstr(ys)});
for iy := 1 to ys do
begin
setfillstyle(1,iy);
bar(Bx+11,By+(iy*4)+11,Bx+13,By+(iy*4)+13);
end;
setviewport(Bx+5,By+5,Bx+(xs*4)+20,By+(ys*4)+21,true);
ix := ((xs*4)+15) div 2;
iy := ((ys*4)+16) div 2;
getaspectratio(rx,ry);
xp := trunc(iy/(rx/ry));
spz := 7;
mc := succ(iy div spz);
for yp := 1 to MC do
begin
r := pred(xp - (yp*spz));
circle(ix,iy,r);
a[yp].x := ix - r + 2;
a[yp].y := iy;
end;
a[0].x := 16;
a[0].y := 16;
for yp := MC downto 0 do
begin
if yp = 0 then xp := green else xp := yp;
setcolor(xp);
if yp = 0 then pat := 1 else pat := yp mod 12;
setfillstyle(pat,xp);
xf := a[yp].x;
yf := a[yp].y;
{ putpixel(xf,yf-1,red); putpixel(xf,yf+1,red); putpixel(xf-1,yf,red); putpixel(xf+1,yf,red); }
floodfill(xf,yf,white)
end;
end;
procedure FillOutside(Clipper:boolean);
begin
setcolor(yellow);
error := graphresult;
setfillstyle(XhatchFill,blue);
setviewport(0,0,GetMaxX,GetMaxY,false);
rectangle(4,4,GetMaxX-4,GetMaxY-22);
floodfill(GetMaxX,GetMaxY,white);
outtextxy(20,GetMaxY-8,'GraphResult:'+fstr(Error)+' '+GraphErrorMsg(Error));
ModeName := GetModeName(gm);
outtextxy(20,GetMaxY-17,ModeName);
end;
var temp : integer;
BEGIN
if ParamCount > 0 then
begin
s := ParamStr(1);
if (s[1] > '1') and (s[1] < '9') then
StartMode := ord(s[1]) and $f;
end;
gd := 0;
gm := StartMode;
result := installuserdriver({'EGAVGA'}{'VESA16'}'BGI256',{ @AutoDet}nil);
ERROR := graphresult;
setgraphbufsize(65520);
gd := result;
initgraph(gd,gm,'');
SetWriteMode(TextMode+MoveWrite);
setwritemode(FloodFillType+AutoFill);
SetWriteMode(FloodFillType+BorderFill);
SetWriteMode(FillMode+MoveWrite);
{ setwritemode(FloodFillType+SeedFill); }
{ setwritemode(FloodFillType+ComplexFill); }
{ setwritemode(FloodFillType+FillDelayOn); }
{ setwritemode(FloodFillType+FillTracerOn); }
(*
setcolor(5);
setfillstyle(1,1); {test for seed/border match}
bar(10,10,100,100); {should stop immediately}
setcolor(red); {ie, nothing should happen}
setfillstyle(1,red);
bar(50,50,50,50);
rectangle(9,9,101,101);
setfillstyle(1,7);
floodfill(50,50,red);
readln;
halt(1);
*)
cleardevice;
setcolor(white);
FillPatternHorz(10,10,GetMaxX,GetMaxY);
(*
setcolor(white);
rectangle(0,0,GetMaxX,GetMaxY);
*)
setwritemode(FillMode+xorWrite);
FillOutside(false);
readln;
cleardevice;
setwritemode(FloodFillType+SeedFill);
setwritemode(FillMode+MoveWrite);
FillPatternVert(10,10,GetMaxX,GetMaxY);
setwritemode(FloodFillType+SeedFill);
setwritemode(FillMode+OrWrite);
FillOutside(false);
readln;
cleardevice;
setwritemode(FloodFillType+BorderFill);
SetWriteMode(FillMode+MoveWrite);
FillPatternSpiral(10,10,GetMaxX,GetMaxY);
setwritemode(FloodFillType+BorderFill);
setwritemode(FillMode+NotMoveWrite);
FillOutside(false);
readln;
cleardevice;
setwritemode(FloodFillType+BorderFill);
SetWriteMode(FillMode+MoveWrite);
FillPatternGrill(10,10,GetMaxX,GetMaxY);
setwritemode(FloodFillType+SeedFill);
setwritemode(FillMode+NotXorWrite);
FillOutside(false);
readln;
setwritemode(FloodFillType+BorderFill);
setwritemode(FloodFillType+AutoFill);
setwritemode(FloodFillType+FillDelayOn);
setwritemode(FloodFillType+FillTracerOn);
for mm := 0 to 15 do
begin
cleardevice;
SetWriteMode(FillMode+MoveWrite);
setwritemode(FloodFillType+mm);
FillPatternCircle(10,10,GetMaxX,GetMaxY);
setwritemode(FillMode+XorWrite);
FillOutside(false);
delay(500);
end;
readln;
closegraph;
END.