program beadando43pm4;
{Irta: Szamoskozi Peter - 2000. 02. 24.}
uses crt,dos;
{(43. feladat) viz:0.0 - szfold: >0}
const maxc=794;  {tobbnel "stack overflow..."}
     tulszel=20; {A tulso partot jelzo ertek a mereseknel}
type tindex=integer;
     telem=integer;
     TmeresInt=array[1..maxc] of telem;
     Tigaztomb=array[1..maxc] of boolean;
var Tomb:tmeresint;
    Tmax:integer; {Legfeljebb hany meresunk lehet a tengeren?}
    szgdb:integer; {ennyi sziget van}
    sordb:shortint; {ennyi sor van a kepernyon}
    filebol,fileba:boolean; {Honnan olvasson adatokat?}
    f,fki,fbe:text; {a file logikai valtozoja}
    fkinev,fbenev:string; {a file neve}
    muv:boolean; {milyen muveletet akarunk a file-al vegezni? /1-ir,0-olvas/}

procedure igaze(var x:tmeresint);
{Biz. be: minden sziget legmagasabb pontja egyben csucs is!}
var szgcsucsigaze:tigaztomb; {a(z) i. szigetnel igaz-e az allitas}
    lmhcsucsmaxhely:integer; {a legmag. cs. merete - LegMagHelygyujt}
    melyik:tindex; {a maxpontkivalaszthoz}
    be:char; {"megegyszer?"}
    igazei:integer;

  function szigetkezdet(const T:tmeresint; var index:integer):boolean;
  var sve,svv:boolean;
  begin
    sve:=(T[index]>0); dec(index);
    svv:=(T[index]=0); inc(index);
    if ((sve=true) and (svv=true)) then begin
        szigetkezdet:=true; inc(szgdb); end
      else szigetkezdet:=false;
  end;

  function szigetvege(const T:tmeresint; var index:integer):boolean;
  var sve,svv:boolean;
  begin
    sve:=(T[index]=0); dec(index);
    svv:=(T[index]>0); inc(index);
    szigetvege:=((sve=true) and (svv=true));
  end;

  function tulsopart(const T:tmeresint;i:integer):boolean;
  begin
    tulsopart:=(T[i]=tulszel);
  end;

  function csucse(const x:tmeresint; var index:tindex):boolean;
  var sve,svv:boolean;
  begin
    sve:=(x[index]>x[index-1]); inc(index);
    svv:=(x[index]<x[index-1]); dec(index);
    csucse:=((sve=true) and (svv=true));
  end;

  procedure legmaghelygyujt(const x:tmeresint; var i:tindex; csucsrendben:boolean);
  var volte:boolean;
      maxpontsv:tindex;
    procedure maxpontkivalaszt(const x:tmeresint; var i:tindex; volte2:boolean);
    {Kivalasztja egy sziget legmagasabb pontjai kozul a legelsot}
    begin
      if (volte2=false) then begin melyik:=i; volte2:=true; end;
      inc(i);
      if x[melyik]<x[i] then melyik:=i;
      if (not(szigetvege(x,i))) then maxpontkivalaszt(x,i,volte2);
    end; {--- maxpontkivalaszt ---}
  begin {-- legmaghelygyujt --}
    if csucsrendben then begin
      if not(szigetvege(x,i)) then begin
        volte:=false; maxpontkivalaszt(x,i,volte);
        csucsrendben:=csucse(x,melyik);
      end;
    end; { if(csucsrendben) }
  end; {- Legmaghelygyujt -}
  procedure igazemindig(const x:tmeresint; i:tindex);
  var voltee:boolean;
  szgaktjo:boolean;
  begin
    if szigetkezdet(x,i) then begin
      if szgdb=1 then begin
          writeln(fki); writeln(fki);
          write(fki,'A(z) 1. szigetnel igaz az allitas? '); end
        else write(fki,'A(z) ',szgdb,'. szigetnel igaz az allitas? ');
      voltee:=false; szgaktjo:=true;
      legmaghelygyujt(x,i,szgaktjo);
      szgaktjo:=csucse(x,melyik);
      szgcsucsigaze[szgdb]:=szgaktjo;
      writeln(fki,szgaktjo);
      end; { if (szgdb=1) }
    inc(i);
       if not(tulsopart(x,i)) then igazemindig(x,i);
  end; {- Igazemindig -}

  function ellenoriz(var n:tindex; const t:tigaztomb):boolean;
  begin
    if t[n]=true then begin
        if (n>1) then begin
            dec(n); ellenoriz:=ellenoriz(n,t); end
          else begin
            ellenoriz:=t[n]; end
        end
     else begin ellenoriz:=false; end; {ha hamis erteket talalt}
  end; {- ellenoriz -}
begin {- Igaze -}
  igazei:=2;
  igazemindig(x,igazei);
  writeln(fki,'--- Osszesegeben a(z) allitas: ',ellenoriz(szgdb,szgcsucsigaze));
end; {- Igaze -}

procedure tombfeltolt(var t:tmeresint; i:tindex; hogyan:boolean);
var korabbanvolt:boolean; j:tindex;
  procedure manfeltolt(var t:tmeresint; const i:tindex; var j:tindex; var volt:boolean);
  var svmer:integer; svmerbe:char; ok:integer;
  begin
    if volt=false then begin volt:=true; j:=3; end;
    if (j<=(i-2)) then begin
        if ( length(fkinev)=0 ) then write(fki,'A(z) ',j,'. meres eredmenye? ')
          else writeln(fki,'A(z) ',j,'. meres eredmenye? ');
        readln(fbe,svmerbe);
        val(svmerbe,svmer,ok);
        if (ok=0) then begin t[j]:=svmer; inc(j); end;
        manfeltolt(t,i,j,volt);
    end;
  end; {-- manfeltolt --}
  procedure autofeltolt(var t:tmeresint; const i:tindex; var j:tindex; var volt:boolean);
  begin
    if volt=false then begin volt:=true; j:=3; end;
    if (j<=(i-2)) then begin
         t[j]:=(random(i) mod 5); inc(j); autofeltolt(t,i,j,volt); end;
  end; {-- autofeltolt --}
begin {- tombfeltolt -}
  korabbanvolt:=false; j:=1;
  t[1]:=tulszel; t[2]:=0;
  t[tmax]:=tulszel; t[tmax-1]:=0;
  if hogyan=true then manfeltolt(t,i,j,korabbanvolt)
         else autofeltolt(t,i,j,korabbanvolt);
end; {- tombfeltolt -}

procedure cim;
  begin
    writeln(fki);
    writeln(fki,'         (A 43-as sorszamu) Szigetes pelda megoldasa rekurzioval');
    writeln(fki,'         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~');
    writeln(fki,'               Irta: Szamoskozi Peter (2001. februar 24.)');
    writeln(fki); writeln(fki);
end; {- cim -}

procedure foprogram;
var svbe:char; svlogp:boolean; be:char;

  procedure cls(var sdb:shortint);
  begin
    if (sdb>1) then begin dec(sdb); writeln{(sdb)}; cls(sdb); end
      else writeln;
  end; {-- cls --}

  procedure fileok;
  var probaszam:byte; {a probalkozasok szama}
    procedure fnevbeker(var hanyszor:byte; var ff:text; const muvbe:boolean);
    var holvanfile:string;
    begin
      if ( (hanyszor>0) and (hanyszor<=3) ) then begin
        if not(muvbe) then begin {olvas}
            write('Melyik file-bol (letezo, 8 kar. hosszu nevu)? ');
            readln(fbenev);
            if ((length(fbenev)<1) or (length(fbenev)>8)) then
              begin dec(hanyszor); fnevbeker(hanyszor,ff,muvbe); end;
            fbenev:=fbenev+'.txt';
            holvanfile:=FSearch(fbenev,GetEnv('PATH'));
            {eleresi ut:FExpand(holvanfile)}
            if holvanfile='' then begin
               dec(hanyszor); fnevbeker(hanyszor,ff,muvbe); end
          end {olvas}
        else begin {ir}
          write('Melyik file-ba? (8 kar. hosszu nevu - felulirodik!) ');
          readln(fkinev);
          if ((length(fkinev)<1) or (length(fkinev)>8)) then
             begin dec(hanyszor); fnevbeker(hanyszor,ff,muvbe); end;
          fkinev:=fkinev+'.txt';
        end; {ir}
      end; { if(hanyszor>0) }
    end; {-- fnevbeker --}
    procedure mibol(const beki:boolean); {be:0,ki:1}
    var be:char;
    begin
      if beki=false then begin
        write('File-bol akar dolgozni (n/*) ? ');
        readln(be);
        if ( upcase(be)='N' ) then filebol:=false else filebol:=true; end
      else begin write('File-ba akar dolgozni (n/*) ? ');
        readln(be);
        if ( upcase(be)='N' ) then fileba:=false else fileba:=true; end;
    end; {--- mibol ---}
   begin
     {olvasas}
     muv:=false; mibol(muv); probaszam:=2;
     if filebol then begin
         fnevbeker(probaszam,fbe,muv); assign(fbe,fbenev); end
       else assigncrt(fbe);
     if ((probaszam=0) or (probaszam>3)) then assigncrt(fbe)
       else reset(fbe);
     {iras}
     muv:=true; mibol(muv); probaszam:=2;
     if fileba then begin
         fnevbeker(probaszam,fbe,muv); assign(fki,fkinev); end
       else assigncrt(fki);
     if probaszam=0 then assigncrt(fki);
     rewrite(fki);
  end; {-- fileok --}

  procedure adatbeker;
    procedure tmaxbeker(var ertek:integer);
    var ok:integer; ertekbe:string;
    begin
      if ( length(fkinev)<>0 ) then write(fki,'A meresek szama (poz. egesz, >5)? ');
      write('A meresek szama (5<max<',maxc,' egesz)? ');
      readln(fbe,ertekbe);
      val(ertekbe,ertek,ok);
      if ( (ok<>0) or (ertek<=5) or (ertek>maxc)) then tmaxbeker(ertek);
      if ( length(fkinev)<>0 ) then writeln(fki,ertek);
    end; {--- tmaxbeker ---}
  begin {-- adatbeker --}
    if ( length(fkinev)<>0 ) then write(fki,'Automata legyen a feltoltes? ');
    write('Automata legyen a feltoltes? ');
    readln(fbe,svbe);
    if upcase(svbe)='N' then svlogp:=true
        else svlogp:=false;
          if ( length(fkinev)<>0 ) then writeln(fki,svbe);
    tmaxbeker(tmax);
      tombfeltolt(tomb,tmax,svlogp);
  end; {-- adatbeker --}
  procedure adatkiir;
  var i:integer; m:integer; t:integer;
  begin
    writeln(fki); writeln(fki,'A tomb elemei: ');
    write(fki,'[ ',tomb[1]); t:=(tmax-1);
    for i:=2 to t do begin
      m:=(i mod 25);
      if (m=0) then writeln(fki,', ',tomb[i],',')
       else if (m=1) then write(fki,tomb[i])
         else write(fki,', ',tomb[i]);
    end;
    inc(i); m:=(i mod 25);
    if (m=0) then writeln(fki,', ',tomb[i],' ]')
      else if (m=1) then write(fki,tomb[i],' ]')
        else write(fki,', ',tomb[i],' ]');
 end; {-- adatkiir --}
begin {- foprogram -}
  sordb:=10; szgdb:=0;
  cls(sordb);
  fileok;
  cim;
  adatbeker;
  adatkiir;
  igaze(tomb);
  close(fbe); close(fki);
  write('Folytassam? ');
  readln(be);
  if ( upcase(be)<>'N' ) then foprogram;
end; {- foporgram -}

begin
randomize;
foprogram;
end.