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 >
Pascal/Delphi Source File  |  1992-12-28  |  11KB  |  383 lines
  1.  
  2. {How good is your floodfill routine?}
  3. {Can it survive this obstical course?}
  4. {This program generates a worst case pattern for floodfill}
  5. {then calls the floodfill routine to fill the pattern.}
  6. {A badly implemented floodfill will blowup}
  7. {a poorly implemented floodfill will leave holes}
  8. {a typical floodfill will run out of memory and give up }
  9. { part way through filling the pattern.}
  10. {A fantastic floodfill will fill the whole pattern.}
  11. {Also notice the little color squares at the top or left of the pattern}
  12. { this shows the type of floodfill you have. If the colors get }
  13. { overwritten, then you have a border bound floodfill.}
  14. { If the color squares remain intact, then you have a}
  15. { seed bound flood fill.}
  16. { The floodfill should leak out of the hole in the upper left corner}
  17. { of the inner rectangle, and should be clipped to the middle area}
  18. { between the two rectangles. If the floodfill fills the entire}
  19. { area between the inner and outer rectangles, then it is not}
  20. { clipping correctly to the viewport.
  21. {If the floodfill does not fill the entire pattern and leaves holes}
  22. { in the areas to be filled, it means that the floodfill does not}
  23. { fail gracefully. A good floodfill recognizes that it may run out of}
  24. { memory and will backup filling what it can on the way back.}
  25. { a poor floodfill will bomb out and leave holes all over the place.}
  26. {Can your floodfill handle patterns? Can it deal with the edge of the}
  27. { screen? The area outside the test rectangle should be filled with}
  28. { a blue crosshatch if the floodfill is working correctly.}
  29. {Finally, if everything went right, the GraphResult printed at the}
  30. {bottom of the screen in yellow should show a value of zero.}
  31. {If you got an error because you ran out of memory, it should say that}
  32.  
  33. PROGRAM FloodTst;
  34. uses crt,graph,WrMode;
  35. var gd,gm,mm:integer;
  36.     imagearray:array[0..1000] of byte;
  37.     RESULT,error:integer;
  38.     s,ModeName:string;
  39.     StartMode : integer;
  40.  
  41. function fstr(i:integer):string;
  42. var s:string;
  43. begin
  44.   str(i,s);
  45.   fstr := s;
  46. end;
  47.  
  48. {$F+}
  49. function AutoDet:integer;
  50. begin
  51.    AutoDet := StartMode;
  52. end;
  53. {$F-}
  54.  
  55. procedure FillPatternHorz(Bx,By,Sx,Sy:integer);
  56. var ix,iy,xp,yp,xs,ys:integer;
  57. begin
  58.    setviewport(0,0,GetMaxX,GetMaxY,true);
  59.    xs := ((Sx-40) div 8);
  60.    ys := ((Sy-70) div 6);
  61.    setcolor(white);
  62.    rectangle(Bx+0,By+0,Bx+(xs*8)+25,By+(ys*6)+26);
  63.    rectangle(Bx+8,By+8,Bx+(xs*8)+17,By+(ys*6)+18);
  64.    putpixel(Bx+8,By+10,black);
  65.    OutTextXY(Bx,By+(ys*6)+28,'Horizontal flood test');
  66.  
  67.    for ix := 1 to pred(xs) do
  68.    begin
  69.      setfillstyle(1,ix);
  70.      bar(Bx+(ix*8)+11,By+11,Bx+(ix*8)+13,By+13);
  71.    end;
  72.  
  73.    for iy := 1 to ys do
  74.    begin
  75.      for ix := 1 to xs do
  76.      begin
  77.        xp := Bx+(ix*8);
  78.        yp := By+8+(iy*6);
  79.        line(xp,yp,xp+4,yp+4);
  80.        line(xp+4,yp+4,xp+8,yp);
  81.        line(xp+8,yp+3,xp+12,yp+7);
  82.        line(xp+12,yp+7,xp+16,yp+3);
  83.      end;
  84.    end;
  85.  
  86.   setviewport(Bx+5,By+5,Bx+(xs*8)+20,By+(ys*6)+21,true);
  87.   setcolor(red);
  88.   setfillstyle(SolidFill,2);
  89. {  putpixel(7,15,red); putpixel(7,17,red); putpixel(6,16,red); putpixel(8,16,red); }
  90.    floodfill(7,16,white)
  91.  
  92. end;
  93.  
  94.  
  95. procedure FillPatternVert(Bx,By,Sx,Sy:integer);
  96. var ix,iy,xp,yp,xs,ys:integer;
  97. begin
  98.    setviewport(0,0,GetMaxX,GetMaxY,true);
  99.    xs := ((Sx-50) div 6);
  100.    ys := ((Sy-60) div 8);
  101.    setcolor(white);
  102.    rectangle(Bx+0,By+0,Bx+(xs*6)+28,By+(ys*8)+21);
  103.    rectangle(Bx+8,By+8,Bx+(xs*6)+20,By+(ys*8)+13);
  104.    putpixel(Bx+8,By+10,black);
  105.    OutTextXY(Bx,By+(ys*8)+23,'Vertical flood test');
  106.  
  107.    for iy := 1 to pred(ys) do
  108.    begin
  109.      setfillstyle(1,iy);
  110.      bar(Bx+11,By+(iy*8)+11,Bx+13,By+(iy*8)+13);
  111.    end;
  112.  
  113.    for iy := 1 to ys do
  114.    begin
  115.      for ix := 1 to xs do
  116.      begin
  117.        xp := Bx+(ix*6)+10;
  118.        yp := By+(iy*8);
  119.        line(xp,yp,xp+4,yp+4);
  120.        line(xp+4,yp+4,xp,yp+8);
  121.        line(xp+3,yp+8,xp+7,yp+12);
  122.        line(xp+6,yp+5,xp+4,yp+7);
  123.       end;
  124.    end;
  125.  
  126.    setviewport(Bx+5,By+5,Bx+(xs*6)+23,By+(ys*8)+16,true);
  127.    setcolor(red);
  128.    setfillstyle(SolidFill,2);
  129. {  putpixel(17,5,red); putpixel(17,7,red); putpixel(16,6,red); putpixel(18,6,red); }
  130.     floodfill(17,6,white)
  131.  
  132. end;
  133.  
  134.  
  135. procedure FillPatternSpiral(Bx,By,Sx,Sy:integer);
  136. var ix,iy,xp,yp,xs,ys:integer;
  137. begin
  138.    setviewport(0,0,GetMaxX,GetMaxY,true);
  139.    xs := ((Sx-40) div 4);
  140.    ys := ((Sy-70) div 4);
  141.    setcolor(white);
  142.    rectangle(Bx+0,By+0,Bx+(xs*4)+25,By+(ys*4)+26);
  143.    rectangle(Bx+8,By+8,Bx+(xs*4)+17,By+(ys*4)+18);
  144.    putpixel(Bx+8,By+10,black);
  145.    OutTextXY(Bx,By+(ys*4)+28,'Spiral flood test'{   x:'+fstr(xs)+' y:'+fstr(ys)});
  146.  
  147.    moveto(Bx+((xs*4)div 2)+8,By+((ys*4) div 2)+12);
  148.    ix := 2;
  149.    yp := (((ys*4)+10) div 4) -1;
  150.    for iy := 0 to yp do
  151.    begin
  152.      linerel(ix,0);
  153.      linerel(0,ix);
  154.      inc(ix,2);
  155.      linerel(-ix,0);
  156.      linerel(0,-ix);
  157.      inc(ix,2);
  158.    end;
  159.  
  160.    for iy := 1 to pred(ys) do
  161.    begin
  162.      setfillstyle(1,iy);
  163.      bar(Bx+11,By+(iy*4)+11,Bx+13,By+(iy*4)+13);
  164.    end;
  165.  
  166.    setviewport(Bx+5,By+5,Bx+(xs*4)+20,By+(ys*4)+21,true);
  167.    setcolor(red);
  168.    setfillstyle(SolidFill,2);
  169.    xs := (xs*4);
  170. {  putpixel(xs,5,red); putpixel(xs,7,red); putpixel(xs-1,6,red); putpixel(xs+1,6,red); }
  171.     floodfill(xs,6,white)
  172.  
  173. end;
  174.  
  175.  
  176. procedure FillPatternGrill(Bx,By,Sx,Sy:integer);
  177. var ix,iy,xp,yp,xs,ys:integer;
  178. begin
  179.    setviewport(0,0,GetMaxX,GetMaxY,true);
  180.    xs := ((Sx-40) div 4);
  181.    ys := ((Sy-70) div 4);
  182.    setcolor(white);
  183.    rectangle(Bx+0,By+0,Bx+(xs*4)+25,By+(ys*4)+26);
  184.    rectangle(Bx+8,By+8,Bx+(xs*4)+17,By+(ys*4)+18);
  185.    putpixel(Bx+8,By+10,0);
  186.    OutTextXY(Bx,By+(ys*4)+28,'Grill flood test'{   x:'+fstr(xs)+' y:'+fstr(ys)});
  187.  
  188. {   moveto(Bx+((xs*4)div 2)+8,By+((ys*4) div 2)+12); }
  189.    ix := Bx+20;
  190.    iy := By+10;
  191.    yp := (((ys*4)+10) div 4);
  192.    line(ix,iy+(ys*2),ix+(xs*4)-8,iy+(ys*2));
  193.  
  194.    for xp := 0 to (xs-2)*2 do
  195.    begin
  196.      line(ix+(xp*2),iy,ix+(xp*2),iy+(ys*4)+6);
  197.    end;
  198.  
  199.  
  200.    for iy := 1 to ys do
  201.    begin
  202.      setfillstyle(1,iy);
  203.      bar(Bx+11,By+(iy*4)+11,Bx+13,By+(iy*4)+13);
  204.    end;
  205.  
  206.    setviewport(Bx+5,By+5,Bx+(xs*4)+20,By+(ys*4)+21,true);
  207.    setcolor(red);
  208.    setfillstyle(SolidFill,2);
  209.    xs := (xs*4);
  210. {  putpixel(16,15,red); putpixel(16,17,red); putpixel(15,16,red); putpixel(17,16,red); }
  211.     floodfill(16,16,white)
  212.  
  213. end;
  214.  
  215. procedure FillPatternCircle(Bx,By,Sx,Sy:integer);
  216. var r,ix,iy,xp,yp,xs,ys,xf,yf,pat:integer;
  217.     mc,spz,rx,ry:word;
  218.     a : array[0..1000] of pointtype;
  219. begin
  220.    setviewport(0,0,GetMaxX,GetMaxY,true);
  221.    xs := ((Sx-40) div 4);
  222.    ys := ((Sy-70) div 4);
  223.    setcolor(white);
  224.    rectangle(Bx+0,By+0,Bx+(xs*4)+25,By+(ys*4)+26);
  225.    rectangle(Bx+8,By+8,Bx+(xs*4)+17,By+(ys*4)+18);
  226.    putpixel(Bx+8,By+10,0);
  227.    OutTextXY(Bx,By+(ys*4)+28,'Circle flood test'{   x:'+fstr(xs)+' y:'+fstr(ys)});
  228.  
  229.    for iy := 1 to ys do
  230.    begin
  231.      setfillstyle(1,iy);
  232.      bar(Bx+11,By+(iy*4)+11,Bx+13,By+(iy*4)+13);
  233.    end;
  234.  
  235.    setviewport(Bx+5,By+5,Bx+(xs*4)+20,By+(ys*4)+21,true);
  236.    ix := ((xs*4)+15) div 2;
  237.    iy := ((ys*4)+16) div 2;
  238.    getaspectratio(rx,ry);
  239.  
  240.    xp := trunc(iy/(rx/ry));
  241.  
  242.    spz := 7;
  243.    mc := succ(iy div spz);
  244.    for yp := 1 to MC do
  245.    begin
  246.      r := pred(xp - (yp*spz));
  247.      circle(ix,iy,r);
  248.      a[yp].x := ix - r + 2;
  249.      a[yp].y := iy;
  250.    end;
  251.  
  252.   a[0].x := 16;
  253.   a[0].y := 16;
  254.   for yp := MC downto 0 do
  255.   begin
  256.     if yp = 0 then xp := green else xp := yp;
  257.     setcolor(xp);
  258.     if yp = 0 then pat := 1 else pat := yp mod 12;
  259.  
  260.     setfillstyle(pat,xp);
  261.     xf := a[yp].x;
  262.     yf := a[yp].y;
  263.   {  putpixel(xf,yf-1,red); putpixel(xf,yf+1,red); putpixel(xf-1,yf,red); putpixel(xf+1,yf,red); }
  264.  
  265.     floodfill(xf,yf,white)
  266.   end;
  267. end;
  268.  
  269. procedure FillOutside(Clipper:boolean);
  270. begin
  271.   setcolor(yellow);
  272.   error := graphresult;
  273.   setfillstyle(XhatchFill,blue);
  274.   setviewport(0,0,GetMaxX,GetMaxY,false);
  275.   rectangle(4,4,GetMaxX-4,GetMaxY-22);
  276.   floodfill(GetMaxX,GetMaxY,white);
  277.   outtextxy(20,GetMaxY-8,'GraphResult:'+fstr(Error)+' '+GraphErrorMsg(Error));
  278.   ModeName := GetModeName(gm);
  279.   outtextxy(20,GetMaxY-17,ModeName);
  280. end;
  281.  
  282. var temp : integer;
  283.  
  284. BEGIN
  285.   if ParamCount > 0 then
  286.   begin
  287.     s := ParamStr(1);
  288.     if (s[1] > '1') and (s[1] < '9') then
  289.       StartMode := ord(s[1]) and $f;
  290.   end;
  291.   gd := 0;
  292.   gm := StartMode;
  293.   result := installuserdriver({'EGAVGA'}{'VESA16'}'BGI256',{ @AutoDet}nil);
  294.   ERROR := graphresult;
  295.  
  296.   setgraphbufsize(65520);
  297.   gd := result;
  298.   initgraph(gd,gm,'');
  299.  
  300.   SetWriteMode(TextMode+MoveWrite);
  301.   setwritemode(FloodFillType+AutoFill);
  302.   SetWriteMode(FloodFillType+BorderFill);
  303.   SetWriteMode(FillMode+MoveWrite);
  304.  
  305. {  setwritemode(FloodFillType+SeedFill); }
  306. {  setwritemode(FloodFillType+ComplexFill); }
  307. {  setwritemode(FloodFillType+FillDelayOn);  }
  308. {  setwritemode(FloodFillType+FillTracerOn); }
  309.  
  310. (*
  311.   setcolor(5);
  312.   setfillstyle(1,1);  {test for seed/border match}
  313.   bar(10,10,100,100); {should stop immediately}
  314.   setcolor(red);      {ie, nothing should happen}
  315.   setfillstyle(1,red);
  316.   bar(50,50,50,50);
  317.   rectangle(9,9,101,101);
  318.   setfillstyle(1,7);
  319.   floodfill(50,50,red);
  320.   readln;
  321.   halt(1);
  322. *)
  323.  
  324.  
  325.   cleardevice;
  326.   setcolor(white);
  327.   FillPatternHorz(10,10,GetMaxX,GetMaxY);
  328. (*
  329.   setcolor(white);
  330.   rectangle(0,0,GetMaxX,GetMaxY);
  331. *)
  332.   setwritemode(FillMode+xorWrite);
  333.   FillOutside(false);
  334.   readln;
  335.  
  336.   cleardevice;
  337.   setwritemode(FloodFillType+SeedFill);
  338.   setwritemode(FillMode+MoveWrite);
  339.   FillPatternVert(10,10,GetMaxX,GetMaxY);
  340.   setwritemode(FloodFillType+SeedFill);
  341.   setwritemode(FillMode+OrWrite);
  342.   FillOutside(false);
  343.   readln;
  344.  
  345.   cleardevice;
  346.   setwritemode(FloodFillType+BorderFill);
  347.   SetWriteMode(FillMode+MoveWrite);
  348.   FillPatternSpiral(10,10,GetMaxX,GetMaxY);
  349.   setwritemode(FloodFillType+BorderFill);
  350.   setwritemode(FillMode+NotMoveWrite);
  351.   FillOutside(false);
  352.   readln;
  353.  
  354.   cleardevice;
  355.   setwritemode(FloodFillType+BorderFill);
  356.   SetWriteMode(FillMode+MoveWrite);
  357.   FillPatternGrill(10,10,GetMaxX,GetMaxY);
  358.   setwritemode(FloodFillType+SeedFill);
  359.   setwritemode(FillMode+NotXorWrite);
  360.   FillOutside(false);
  361.   readln;
  362.  
  363.   setwritemode(FloodFillType+BorderFill);
  364.   setwritemode(FloodFillType+AutoFill);
  365.   setwritemode(FloodFillType+FillDelayOn);
  366.   setwritemode(FloodFillType+FillTracerOn);
  367.  
  368.   for mm := 0 to 15 do
  369.   begin
  370.     cleardevice;
  371.     SetWriteMode(FillMode+MoveWrite);
  372.     setwritemode(FloodFillType+mm);
  373.     FillPatternCircle(10,10,GetMaxX,GetMaxY);
  374.     setwritemode(FillMode+XorWrite);
  375.     FillOutside(false);
  376.     delay(500);
  377.   end;
  378.   readln;
  379.   closegraph;
  380.  
  381. END.
  382.  
  383.