unit infkeret;

interface

{R+}
uses crt,dos,graph;
const pmax=5; tmax=128; rndszorzo=100;
      pba1=400; pba2=245; pba3=640; pba4=pba2; {parbeszed-ablak ac:280}
      spc=#219#219#219#219#219#219#219#219#219#219#219#219#219#219#219#219#219#219#219#219#219#219#219#219#219#219#219#219;

var mxi,mxj:integer; Alapelt:integer; { 8* ( 1500/(mxi*xmj) ) }
    falsebvalt:real{0.3}; legvege:char; nepsuruseg:real;
    hol:PathStr;

type TElem=record
       nem:shortint;
       szin:byte; end;
     Tomb=array[1..50,1..30] of Telem;
     TParam=record
       nev:string;
       ertek:integer;
     end;
     TParamTomb=array[1..pmax] of TParam;
var SzimIdo:integer; urestomb:tomb; vegee:boolean;
    T:tomb; P:TParamtomb;
    csendese,lepesben:boolean; ch:char;

const
p1='™ssz. l‚tsz m:         '; p2='Nagyˇt s:              ';
p3='Sebess‚g-szorz˘ (fal): '; p4='Csendes?               ';
p5='Egyes‚vel l‚ptet‚s?    '; p6='N‚ps–r–s‚g:            ';
p7='Az egavga.bgi helye:   ';

const ns='Norm l '; cs=' Csendes '; ls=' L‚p‚sben ';
    ps=' Pihen '; ss=' Segˇts‚g '; ms=' M˘dosˇt '; qs=' Kil‚p ';

Procedure DosIndul;
Procedure Msgures(const ki_e:boolean);
Procedure TombNullaz(var t:tomb);
Procedure inic(var holsv:PathStr;var vege:boolean);
Procedure IndErtekBeallit(var T:tomb; P:TParamTomb);
Procedure AbraRajzol(const T:tomb);
Procedure GrafikonRajzol(const T:tomb; szimido,eltx,elty,mxi,mxj:integer);
Procedure KorTablaRajz(const T:tomb; szimido:integer);
Procedure IdoKiir(const szimido:integer);
Procedure TombErtekvaltoztat(var T:tomb);
Procedure PbAbl(const s1,s2:string; hova:boolean);
Procedure ParamKiir(const p1,p2,p3,p4,p5,p6,p7:string);
Procedure AlkeretRajzol(const alc,grc:string);
Procedure FoKeretRajzol(const focim:string);
Procedure szunet;
Procedure SzimLepes(const szimido:integer; csendese:boolean; lepesben:boolean; var T:tomb);
Procedure BillreVar(var vegee:boolean; T:Tomb; P:TParamTomb; focim,alkeretcim,grafcim:string);
Procedure Foprogram(const szimfocim,alkeretcim,grafcim:string);

implementation

Procedure DosIndul;
var i:byte; be:string; ok:integer; sv:real;
begin
  clrscr; for i:=1 to 15 do writeln;
  repeat
    write('A szimul ci˘ elemeinek darabsz ma? (5..50) '); readln(be);
    val(be,mxi,ok);
  until ((ok=0) and (5<mxi) and (mxi<=50)); writeln;
  repeat
    write('... milyen s–r–s‚ggel? (0..9) '); readln(be);
    val(be,nepsuruseg,ok); sv:=trunc(nepsuruseg);
  until ((ok=0) and (0<nepsuruseg) and (nepsuruseg<10) and (sv=nepsuruseg)); writeln;
  nepsuruseg:=(nepsuruseg/10);
  {repeat
    write('A fal a mol. sebess‚g‚t mennyire befoly solja? (0..9) '); readln(be);
    val(be,falsebvalt,ok); sv:=trunc(falsebvalt);
  until ((ok=0) and (0<falsebvalt) and (falsebvalt<10) and (sv=falsebvalt));
  falsebvalt:=(falsebvalt/10);}
end;

{v:ok}
Procedure Msgures(const ki_e:boolean);
var ures:string[28];
begin
  ures:=spc; setcolor(0);
  if ki_e
    then OuttextXY(pba1+4,pba2+6,ures)
    else OuttextXY(pba1+4,pba2+23,ures);
  setcolor(15);
  Outtextxy(pba1+4,pba2+6,'*: ');
  Outtextxy(pba1+4,pba2+23,'> ');
end;

{v:ok}
Procedure TombNullaz(var t:tomb);
var i,j:integer;
begin
  for i:=1 to mxi do begin
    for j:=1 to mxj do begin
      T[i,j].nem:=round((random*rndszorzo) / 2);
      if T[i,j].nem=0 then T[i,j].szin:=GetMaxColor
      else T[i,j].szin:=GetMaxColor mod 2
    end;
  end;
end;

{v:ok}
Procedure inic(var holsv:PathStr;var vege:boolean);
var Gd, Gm: Integer; szamol:byte; s:string;
begin
  Gd := Detect; szamol:=0; writeln; vege:=false;
  repeat
    if szamol=0 then begin
       holsv:=FSearch('egavga.bgi','.\egavga.bgi'); inc(szamol); end
    else begin
       write('Hol az egavga.bgi? '); readln(s);
       holsv:=FSearch('egavga.bgi',s); inc(szamol); end;
  until ((szamol=3) or (hol<>''));
  if holsv='' then holsv:=FSearch('egavga.bgi',GetEnv('PATH'));
  InitGraph(Gd, Gm, holsv);
  ClearDevice;
end;

{v:ok}
Procedure IndErtekBeallit(var T:tomb; P:TParamTomb);
var szim_idop,ind_ertek:integer;
begin
  szim_idop:=ind_ertek; mxj:=round(0.6*mxi);
  tombnullaz(T); ch:=' ';
  AlapElt:=round(8*(50/mxi));
  csendese:=false; lepesben:=false;
end;

{v:ok}
Procedure AbraRajzol(const T:tomb);
const EltX=1; EltY=39; melyseg=279; szelesseg=399;
var i,j:integer; x1,y1:integer;
begin
  i:=1; x1:=eltx+1; y1:=elty+1; {eltx+alapelt*i;}
  while ((i<mxi) and (x1<=szelesseg)) do begin j:=1;
    while (j<mxj) do begin
      x1:=eltx+alapelt*i; y1:=elty+alapelt*j;
      PutPixel(x1-2,y1,T[i,j].szin);
      inc(j);
    end;
    inc(i);
  end;
end;

Procedure Kortablarajz(const T:tomb; szimido:integer);
begin

end;


Procedure GrafikonRajzol(const T:tomb; szimido,eltx,elty,mxi,mxj:integer);
{ox=44; oy=370;}
var svri:integer; ido:integer; grx,gry:integer;
  function atlagsebesseg(const t:tomb):real;
  var sv:real; i,j:byte;
  begin
    sv:=0;
    for i:=1 to mxi do
      for j:=1 to mxj do sv:=sv+T[i,j].nem;
    atlagsebesseg:=sv/(mxi*mxj);
  end;
begin
  svri:=round(atlagsebesseg(t))-50;
  ido:=szimido; if ido>556 then ido:=(ido mod 556)+1;
  grx:=eltx+ido; gry:=elty-svri*round(alapelt*0.2);
  SetColor(0); Line(grx,330,grx,420); Line(grx+1,330,grx+1,420);
  SetColor(GetMaxColor);
  PutPixel(grx,370,GetMaxColor); PutPixel(grx,gry,GetMaxColor);
end;

Procedure IdoKiir(const szimido:integer);
var szimstr:string;
begin
  setcolor(0); str(szimido-1,szimstr);
  Outtextxy(550,20,szimstr); str(szimido,szimstr);
  setcolor(15); Outtextxy(550,20,szimstr);
end;

Procedure TombErtekvaltoztat(var T:tomb);
var i,j,k,l:integer; p1,p2:integer;
  procedure veletlenszomszed(const i,j:integer; tav:real; var k,l:integer);
  var sv:longint;
  begin
    sv:=random(trunc(sqrt(tav)))+1;
    k:=(i+sv) mod mxi; if k=0 then inc(k);
    sv:=random(trunc(sqrt(tav)))+1;
    l:=(j+sv) mod mxj; if l=0 then inc(l);
  end;
begin   {ez a SzimLepes erdemi resze -> feladat-specifikus}
  for i:=1 to mxi do begin {50}
   for j:=1 to mxj do begin  {30}
      {i:=random(mxi)-1; j:=random(mxj)-1;}
      if (T[i,j].szin=GetMaxColor)
       then begin
        veletlenszomszed(i,j,T[i,j].nem,k,l);
        if ( ( ((i=mxi) and (k=1)) or ((i=1) and (k=mxi)) ) or ( ((j=mxj) and (l=1)) or ((j=1) and (l=mxj)) ) )
        then begin
          if (T[i,j].nem>0)
            then T[i,j].nem:=(T[i,j].nem +1) div 2
            else T[i,j].nem:=(T[i,j].nem ) div 2;
        end;
        if T[k,l].szin=0 {'szabad'}
        then begin T[k,l]:=T[i,j]; T[i,j].nem:=0; T[i,j].szin:=0; end
       end;
    end;
  end;
end;

Procedure PbAbl(const s1,s2:string; hova:boolean);
var i:byte; ures:string[25];

begin
  ures:=spc; setcolor(0);
  if hova
    then OuttextXY(pba1+4,pba2+6,ures)
    else OuttextXY(pba1+4,pba2+23,ures);
  setcolor(15);
  Outtextxy(pba1+4,pba2+6,s1);
  Line(pba1,(pba2+280) div 2, GetMaxX,(pba2+280) div 2);
  Outtextxy(pba1+4,pba2+23,s2);
end;

Procedure ParamKiir(const p1,p2,p3,p4,p5,p6,p7:string);
var prm1,prm2,prm3,prm4,prm5,prm6,prm7:string;
begin
  str(mxi*mxj,prm1); prm1:=p1+prm1; OutTextXY(406,80,prm1);
  str(trunc(nepsuruseg*100),prm6); prm6:=p6+prm6+'%';
    OutTextXY(406,94,prm6);
  str(alapelt div 8,prm2); prm2:=p2+prm2; OutTextXY(406,108,prm2);
  {str(round(falsebvalt*(rndszorzo)),prm3);
  prm3:=p3+prm3+'%'; OutTextXY(406,122,prm3);}
  if csendese
     then begin prm4:='igen';
       SetColor(0); OutTextXY(590,136,'nem'); SetColor(GetMaxColor); end
     else begin prm4:='nem';
       SetColor(0); OutTextXY(590,136,'igen'); SetColor(GetMaxColor); end;
  prm4:=p4+prm4; OutTextXY(406,136,prm4);
  if lepesben
     then begin prm5:='igen';
       SetColor(0); OutTextXY(590,150,'nem'); SetColor(GetMaxColor); end
     else begin prm5:='nem';
       SetColor(0); OutTextXY(590,150,'igen'); SetColor(GetMaxColor); end;
  prm5:=p5+prm5; OutTextXY(406,150,prm5);
  OutTextXY(418,164,'vissza: 4* [E] ut n "N"');
  prm7:=p7; OutTextXY(406,182,prm7);
  prm7:=FExpand(hol); OutTextXY(418,196,prm7);
end;

Procedure AlkeretRajzol(const alc,grc:string);
const idoc='Id“: '; prc='Param‚terek';
{illett volna inkabb atadni a menu-cimeket} ox=44; oy=370;
begin
  SetLineStyle(0,0,1);
  Line(0,38,GetMaxX,38); {felso}
  Line(400,38,400,280); Line(0,280,GetMaxX,280); {felso, also}
  Line(pba1,pba2,pba3,pba4); pbabl('*: ','> ',true); {parb-ablak /45/}
  OuttextXY(130,20,alc); OutTextXY(510,20,idoc);
  OutTextXY(476,52,prc); Bar(474,60,476+8*length(prc)+2,60);
  ParamKiir(p1,p2,p3,p4,p5,p6,p7);
  Line(40,oy,600,oy); Outtextxy(600,oy-3,'>'); {x}
  Line(ox,330,ox,420); Outtextxy(41,326,'^'); {y}
  OutTextXY(12,294,grc);
  OutTextXY(12+8*length(grc)+8,294,'x:id“ y:l‚tsz mt”bblet');
end;

{v:ok}
Procedure FoKeretRajzol(const focim:string);
var xm,ym:integer; {focim:=' Szimul ci˘ ';}
  procedure felsomenu;
  begin
    SetLineStyle(0,0,3);
    xm:=(GetMaxX div 2) - (5*length(focim));
    xm:=xm-7; ym:=3; Bar(0,6,xm,6); xm:=xm+2;
    OutTextXY(xm,ym,focim);
    xm:=xm+8*length(focim); Bar(xm,6,GetMaxX,6);
  end;

  procedure alsomenu(const ls,qs,cs,ns,ss,ps:string); {l,q,c,n,s,p}
  begin
    xm:=0; ym:=ym-4;
    Line(xm,ym+4,xm+92,ym+4); xm:=xm+100;
    OutTextxy(xm,ym,ns); xm:=xm+6*length(ns)+6;
    OutTextXY(xm,ym,cs); xm:=xm+6*length(cs)+8;
    OutTextXY(xm,ym,ls); xm:=xm+6*length(ls)+10;
    OutTextXY(xm,ym,ps); xm:=xm+6*length(ps)+8;
    OutTextXY(xm,ym,ss); xm:=xm+6*length(ss)+10;
    OutTextXY(xm,ym,ms); xm:=xm+6*length(ms)+8;
    OutTextXY(xm,ym,qs); xm:=xm+6*length(qs)+10;
    Line(xm,ym+4,GetMaxX,ym+4);
  end;
begin
  {procedure SetLineStyle(LineStyle: Word; Pattern: Word; Thickness: Word);}
  {Line Styles: 0 (SolidLn), 1 (DottedLn), 2 (CenterLn),
                3 (DashedLn), 4 (UserBitLn - User-defined line style)
  Line Widths: 1 (NormWidth), 3 (ThickWidth)}
  felsomenu;
  xm:=GetMaxX; ym:=GetMaxY-4;
  Line(0,6,0,ym); Line(xm,6,xm,ym);
  alsomenu(ls,qs,cs,ns,ss,ps);
end;

Procedure szunet;
begin readkey; end;

{*feladatfuggo*}
Procedure SzimLepes(const szimido:integer; csendese:boolean; lepesben:boolean; var T:tomb);
{ido,csendese,lepesben,T}
begin
  IdoKiir(szimido); if lepesben then begin msgures(true);
                    OutTextXY(pba1+20,pba2+6,'ido, '); readln; end;
  ParamKiir(p1,p2,p3,p4,p5,p6,p7); if lepesben then begin
                    OutTextXY(pba1+60,pba2+6,'prm, '); readln; end;
  TombErtekValtoztat(t); if lepesben then begin
                    OutTextXY(pba1+100,pba2+6,'tomb, '); readln; end;

  if not(csendese)
    then begin
      Abrarajzol(T); if lepesben then begin
                    OutTextXY(pba1+148,pba2+6,'abra, '); readln; end;
      GrafikonRajzol(T,szimido,44,370,mxi,mxj); if lepesben then begin
                    OutTextXY(pba1+196,pba2+6,'graf'); readln(ch); end;
    end
    else begin end;
end;

Procedure BillreVar(var vegee:boolean; T:Tomb; P:TParamTomb; focim,alkeretcim,grafcim:string);
var c:char; mutato:pointer;

  procedure segitseg;
  {type TKep=array[1..25,1..80] of tkar; tkepf=file of tkep;
  var f:tkepf; kep:tkep absolute $0b800:$0000;}
  var h,sc:text; svmeret:word;
  procedure filekiir(var h:text; var sc:text);
  var s:string;
  begin
    while not(eof(h)) do begin
      readln(h,s); writeln(sc,s);
    end;
    writeln;
  end;
  begin
    svmeret:=250*250{ImageSize(0,0,GetMaxX,GetMaxY)};
    GetMem( mutato, SizeOf(svmeret)); {mentheto-e}
    if mutato<>nil then GetImage(0,0,GetMaxX,GetMaxY,mutato^); {mentes}

    closegraph; clrscr; assign(h,'helpfile.txt');
    reset(h); assigncrt(sc); rewrite(sc); filekiir(h,sc);
    writeln('ENTER-re vege'); readln; close(h); close(sc); clrscr;
    inic(hol,vegee); fokeretrajzol(focim);
  alkeretrajzol(alkeretcim,grafcim);

    PutImage(0, 0, mutato^, NormalPut);
  end;
  procedure parameterModosit(var p:tparamtomb);
  var benev:char; FelvLe:boolean; svs:string; Felvchar:char;
  begin
    pbabl('Melyiket? /[*]:vege/','',true);
    moveto(pba1+4, pba2+23); str(getx,svs);
    pbabl('Melyiket? /[*]:vege/',svs,false); benev:=readkey;
    pbabl('Fel? ','',true); felvchar:=readkey;
{    if ((upcase(felvchar)='I') or (upcase(felvchar)='Y'))
      then begin
      if keypressed then inc... -> amire a benev mutat}
    case benev of
      'a':begin
            {gotoxy(vami_ertelmes_hely)}
            {writeln(P[1].nev,': ',P[1].ertek,' -> ',mire);
            P[1].ertek:=mire;}
          end;
      {tobbi parameter}
      {else benev:='*';}
    end;
  end;

begin {BillreVar}
  repeat
    inc(szimido); msgures(true);
    if ( (keypressed) or (ch=#13) or (upcase(ch)='N') ) then begin
      if ( (ch<>#13) and (upcase(ch)<>'N') )
        then begin c:=readkey; c:=upcase(c); end
        else begin c:=upcase(ch); ch:=' '; end;
      if ord(c) in [65..90]
       then begin
        case c of
          'N': begin csendese:=false; lepesben:=false;
                   szimlepes(szimido,csendese,lepesben,T); end;
          'L': begin lepesben:=true;
                   szimlepes(szimido,csendese,lepesben,T); end;
          'K': begin vegee:=true; end;
          'C': begin csendese:=true;
                   szimlepes(szimido,csendese,lepesben,T); end;

          'S': begin segitseg; end;
          'M': begin parametermodosit(P); end;
          'P': begin szunet; end
        end; {case}
      end; {then}
    end {keypressed-then}
    else begin {delay(1);} szimlepes(szimido,csendese,lepesben,T); end;
  until (c='K')
end;

{v:ok}
Procedure Foprogram(const szimfocim,alkeretcim,grafcim:string);
begin
  inic(hol,vegee); indertekbeallit(t,p); fokeretrajzol(szimfocim);
  alkeretrajzol(alkeretcim,grafcim);
  repeat
    billrevar(vegee,t,p,szimfocim,alkeretcim,grafcim);
  until (vegee);
  cleardevice;
  closegraph;
end;

begin
  {repeat
    dosindul;
    foprogram;
    write('Ism‚t? (ak r m s adatokkal) '); readln(legvege);
  until (upcase(legvege)='N');
  clrscr;}
{Foprogram:
  Inic - graf
  FokeretRajzol;
  For i:=1 to 5 do begin
    alkereteketRajzol(keret[i],keretcim[i]);
  cv.
  szim_idop:=ind_ertek;
  tombNullaz(T);
  Ciklus...
    billreVar(bill)
  c. amig (bill='kilep')
vege}
end.