{Alapinfok:}
{kezdet: van egy bmp-file, amin pixelenkent vegigmegy}
{ahol *** van, ott valami nagyon_nem_ok}
{lista helyett lehet, hogy celszerubb vermet hasznalni a "kidobas" muvelet miatt, bar...}

const labdaszin=white; hatterszin=black; 
tlapszin=blue; {a teglalapnak}
aktszin=red; {a canvas pixeles bejarasakor eppen holt tartunk - egy pixel}

type TSik=record: bfx,bfy,jax,jay:integer; 
var l:tlista;
teglalap:TSik; {a teglalap: balfent.x, balfent,y, jobblent.x, jobblent,y}

Function kerekit(a:byte):byte
var svr:real; svi:integer;
begin
  svr:=(a+1/8);
  svi:=round(svr);
  kerekit:=svi;
end;

Elj Tlista.kigyujt(a,b: integer);
begin
  l.akt^.x:=a; l.akt^.y:=b;
end;

Procedure rajzol(bfx,bfy,jax,jay:integer; var tcv:TCanvas);
var    i,j:integer; {ciklusvaltozok}
begin
   {rajzolas}
   for i:=bfx to jax do begin
     canvas[i,bfy].color:=tlapszin; {felso oldal}
   end; {i}
   for j:=bfy to jay do begin
     canvas[bfx,j].color:=tlapszin; {bal oldal}
   end; {j}
   ujy:=bfy+lepeskoz; {a lenti csikhoz a szelesseg beallitasa}
   for i:=bfx to jax do begin
     canvas[i,ujy].color:=tlapszin;  {lenti csik}
   end; {i}
   ujx:=bfx+lepeskoz;
   for j:=bfy to jay do begin
     canvas[ujx,j].color:=tlapszin;  {jobb oldal}
   end; {j}
end;

Procedure elmentes(bfx,bfy,jax,jay:integer; var tcv:TCanvas);
var i,j:integer;
begin
{mentes}
   for i:=bfx to jax do begin
    for j:=bfy to jay do begin
     tcv[i,j]:=canvas[i,j];
    end; {j}
   end; {i}
end;

Procedure visszaallitas(bfx,bfy,jax,jay:integer; var tcv:TCanvas);
var i,j:integer;
begin
   {visszaallitas}
   for i:=bfx to jax do begin
    for j:=bfy to jay do begin
     canvas[i,j]:=tcv[i,j];
    end; {j}
   end; {i}
end;

procedure TeglalapEllenorzes (const teglalap:TSik; var db:integer; var joe:boolean);
var i:integer; {ciklusvaltozo}
atlag:real; {a teglalapon belul hany szazalek megfelelo szinu}
db:integer; {a teglalapon belul hany megfelelo szinu pottyot talalt?}
l2:Tlista; {a teglalap megfelelo pontjainak igyujtesehez}
(const elvart=vmi_nagy_szam)
begin
   for i:=teglalap.bfx to teglalap.jax do begin
     for j:=teglalap.bfy to teglalap.jay do begin   {pixeles bejaras}
      if kerekit(pont[i,j].szin)=labdaszin then begin
                   inc db; {mennyit talaltunk}
                   l2.beszur(x,y); {eltesszuk kesobbre}
                 end; {if kerekit...}
     end; {for j}
    end; {for i}
    atlag:=db/i {JoPixelekDB/maxpixel(i) - magyarul, a hely hany szazaleka "labda"}
{*** - TenylegKore-eljaras teljesen hianyzik}
{elvileg: ezen pontok es egy "errefele" levo kor "nagyjabol" fedik-e egymast}
{azaz e ketto kulonbseg-pontjai kevesebben vannak, mint valami konstans ertek}
    if atlag>=elvart then TenylegKore(l2); {az l2-ben levo pontokra kellene}
    if ( (atlag>=elvart) es tenylegkore(l2) ) then joe:=true else joe:=false;
end; {teglalap ellenorzese}

procedure lnemures(var alapsik: TSik; l:Tlista);
var tcv:TCanvas; {a menteshez}
begin
  repeat
    a1:=l.ki(x,y); {elso pont}       a2:=l.ki(x,y); {masodik pont}
   if tavolsag(a1,a2)<2*lepeskoz then begin
        teglalap.bfx:=a1.x-lepeskoz; teglalap.bfy:=a1.y-lepeskoz;
        teglalap.jax:=a2.x+lepeskoz; teglalap.bfy:=a2.y+lepeskoz;
      end  {tavolsag kicsi}

     else {if tavolasg(a1,a2)>=2*lepeskoz} begin
        a:=a1;
        teglalap.bfx:=a.x-lepeskoz; teglalap.bfy:=a.y-lepeskoz;
        teglalap.jax:=a.x+lepeskoz; teglalap.jay:=a.y+lepeskoz;
      end {tavolsag nagy}

     {ezeket mindket ag eseten vegre kell hajtania};
     elmentes(teglalap.bfx, teglalap.bfy, teglalap.jax, teglalap.jay,tcv);   
     rajzol(teglalap.bfx, teglalap.bfy, teglalap.jax, teglalap.jay);
     teglalapellenorzes(teglalap,db); 
     visszaallit(teglalap.bfx, teglalap.bfy, teglalap.jax, teglalap.jay,tcv);
     if not(joe) then begin
            {az aktualisat ki kellene torolni}
            l.kovetkezore; {ez lehet, hogy nem kell, mert automatikusan lepteti az l.ki}
  until ((joe) or (l.urese)); {azaz jo}
     if joe=true then writeln('Megvan a labda')
      {else writeln('Nincs meg a labda'); - elvileg mindig van}
end;

Procedure Elj1(const alapsik: TSik, const lepeskoz:integer; var l:Tlista);
var svszin:byte; {az aktualis pixel milyen szinu}
begin
  For i:=alapsik.bfx to alapsik.jax do begin
   for j:=alapsik.bfy to alapsik.jay do begin
    svszin:=canvas[i,j].color;
    canvas[i,j].color:=aktszin; {bejeloljuk, hol tartunk}
    if kerekit(svszin)=labdaszin then l.beszur(i,j)    {ahol gyanus a pont}
    canvas[i,j].color:=svszin; {az aktualis pixel visszakapja az eredeti szinet}
   end; {for i}
  end; {j}
end; {elj 1}

BEGIN
  l.ures;
  repeat    
    Elj1(alapsik, lepeskoz, l);  {n-esevel pixelenkent jarja be a canvas-t}
    If l.urese and lepeskoz<>1 
          then lepeskoz:=lepeskoz div 2; {lepeskoz felezese}
  until ( not(l.urese) or ((lepeskoz=1) and (l.urese)) )
  if not(l.urese) then lnemures(alapsik,l); {ha talalt labdaszinu pontot}
  {if l.urese then writeln('Nincs labda a kepen'); - elvileg kellene lennie labdanak, mindig}
END.