{Irta: Szamosk”zi P‚ter - szamosp(a)inf.elte.hu - 2001.  prilis 20.}
{Copyright: GPL}
{R+}
uses crt,dos,graph;
const pmax=5; tmax=128; rndszorzo=100;
  pba1=400; pba2=245; pba3=640; pba4=pba2; {parbeszed-ablak ac:280}
const 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; sebes:integer;
type TElem=record
       seb:single;
       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;

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˘ban mennyi r‚szecske legyen? (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); writeln;
  repeat
    write('V rakoztat s / fordˇtott sebes‚g)? (1..',maxint,') '); readln(be);
    val(be,sebes,ok);
  until ((ok=0) and (sebes>1) and (sebes<MaxInt));
end;

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;

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].seb:=random*rndszorzo;
      if T[i,j].seb>nepsuruseg then T[i,j].szin:=GetMaxColor;
    end;
  end;
end;

Procedure inic;
var Gd, Gm: Integer; szamol:byte; s:string;
begin
  Gd := Detect; szamol:=0; writeln;
  repeat
    if szamol=0 then begin
       hol:=FSearch('egavga.bgi','c:\tp\70\bgi\egavga.bgi'); inc(szamol); end
    else begin
       write('Hol az egavga.bgi? '); readln(s);
       hol:=FSearch('egavga.bgi',s); inc(szamol); end;
  until ((szamol=3) or (hol<>''));
  if hol='' then hol:=FSearch('egavga.bgi',GetEnv('PATH'));
  InitGraph(Gd, Gm, hol);
  ClearDevice;
end;

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;

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 GrafikonRajzol(const T:tomb; szimido:integer);
const EltX=44; EltY=370; {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].seb;
    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*alapelt;
  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].seb,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].seb>0.5*rndszorzo)
            then T[i,j].seb:=T[i,j].seb-falsebvalt
            else T[i,j].seb:=T[i,j].seb+falsebvalt;
        end;
        if T[k,l].szin=0 {'szabad'}
        then begin T[k,l]:=T[i,j]; T[i,j].seb:=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;
var prm1,prm2,prm3,prm4,prm5,prm6,prm7:string;
begin
  str(mxi*mxj,prm1);
  prm1:='™ssz. molekulasz m:    '+prm1;
  OutTextXY(406,80,prm1);
  str(trunc(nepsuruseg*100),prm6);
  prm6:='N‚ps–r–s‚g:            '+prm6+'%';
  OutTextXY(406,94,prm6);
  str(alapelt,prm2);
  prm2:='Nagyˇt s:              '+prm2;
  OutTextXY(406,108,prm2);
  str(round(falsebvalt*(rndszorzo)),prm3);
  prm3:='Sebess‚g-szorz˘ (fal): '+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:='Csendes?               '+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:='Egyes‚vel l‚ptet‚s?    '+prm5;
  OutTextXY(406,150,prm5);
  OutTextXY(418,164,'vissza: 4* [E] ut n "N"');
  prm7:='Az egavga.bgi helye:   ';
  OutTextXY(406,182,prm7); prm7:=hol;
  OutTextXY(418,196,prm7);
end;

Procedure AlkeretRajzol;
const idoc='Id“: '; alc='G zmodell, sebess‚gv ltoz ssal';
prc='Param‚terek'; grc='Elt‚r‚s az  tlagsebess‚gt“l: ';
ox=44; oy=370;
begin
  SetLineStyle(0,0,1);
  {Line(500,6,500,30);} Line(0,38,GetMaxX,38); {felso}
  Line(400,38,400,280); {lefele}
  Line(pba1,pba2,pba3,pba4); {parb-ablak /45/}
  Line(0,280,GetMaxX,280); {also}
  pbabl('*: ','> ',true);
  OuttextXY(130,20,alc);
  OutTextXY(510,20,idoc);
  OutTextXY(476,52,prc); Bar(474,60,476+8*length(prc)+2,60);
  ParamKiir;
  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:pixelt v');
end;

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

  procedure alsomenu; {l,q,c,n,s,p}
  var ls,qs,cs,ns,ss,ms,ps:string;
  begin
    ns:='Norm l '; cs:=' Csendes '; ls:=' L‚p‚sben ';
    ps:=' Pause '; ss:=' Segˇts‚g '; ms:=' M˘dosˇt '; qs:=' Quit ';
    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)+8;
    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;
end;

Procedure szunet;
begin readkey; end;

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; 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); 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);
var c:char;

  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:text; sc:text;
  procedure filekiir(var h:text; var sc:text);
  var s:string; i:integer;
  begin
    i:=1;
    while not(eof(h)) do begin
      readln(h,s); writeln(sc,s); inc(i);
      if (i mod 25)=23 then begin
        writeln; write('<ENTER>-re folytat'); readln; end;
    end;
    writeln;
  end;
  begin
    {assign(scrf,'scrtemp.dat'); rewrite(scrf);
    kepernyomentes(scrf);
    close(scrf);}
    cleardevice; closegraph;
    assign(h,'helpfile.txt'); reset(h);
    assigncrt(sc); rewrite(sc);
    filekiir(h,sc);
    writeln('<ENTER>-re v‚ge'); readln; close(h); close(sc);
    clrscr;
    inic; fokeretrajzol; alkeretrajzol;
    {reset(scrf);}
    {kepernyovisszaallit(scrf);
    close(scrf);
    filetorol(scrf);}
  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;
          'Q': 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(sebes); szimlepes(szimido,csendese,lepesben,T); end;
  until (c='Q')
end;

Procedure Foprogram;
begin
  inic; indertekbeallit(t,p); fokeretrajzol; alkeretrajzol;
  repeat
    billrevar(vegee,t,p);
  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.