{$D-,L-,Y-,N-,E-,R-,S-,I-,Q-}
program BladzeniePrzypadkowe;
uses crt;

const
  KWADRAT=30; {'Bok' kwadratu.}
  ITERACJE=10000; {Ilo˜† iteracji algorytmu.}

var
  k,l : integer;
  tabl : array[0..KWADRAT-1,0..KWADRAT-1] of integer;
  liczba : integer;
  wspx,wspy : array[0..KWADRAT-1] of integer;
  f : text;

procedure LosowanieStartu2;

begin
  k:=random(KWADRAT);
  l:=random(KWADRAT);
  inc(tabl[k,l]);
end;

procedure LosowanieStartu3;

var
  tmp : integer;
  i   : integer;

begin
  tmp:=random(liczba);
  for i:=0 to tmp do
    begin
      k:=wspx[i];
      l:=wspy[i];
    end;
end;

function Skok : boolean;

var
  wyskok : boolean;

begin
  wyskok:=TRUE;
    case random(4) of
      0 : if (k > 0) then dec(k) else wyskok:=FALSE;
      1 : if (l > 0) then dec(l) else wyskok:=FALSE;
      2 : if (k < KWADRAT-1) then inc(k) else wyskok:=FALSE;
      3 : if (l < KWADRAT-1) then inc(l) else wyskok:=FALSE;
    end;
     if wyskok=TRUE then
      inc(tabl[k,l]);
    Skok:=wyskok;
end;

procedure Start1;

var
  wyskok : boolean;

begin
  Randomize;
  inc(tabl[k,l]);
  repeat
    wyskok:=Skok;
  until wyskok=FALSE;
end;

procedure Start2;

var
  wyskok : boolean;

begin
  Randomize;
  LosowanieStartu2;
  repeat
    wyskok:=Skok;
  until wyskok=FALSE;
end;

procedure Start3;

var
  wyskok : boolean;

begin
  Randomize;
  LosowanieStartu3;
  repeat
    wyskok:=Skok;
  until wyskok=FALSE;
end;

procedure Main1;

var
  it,i,j,liczba,k1,l1 : integer;
  pr : longint;

begin
  repeat
    write('Podaj wsp¢ˆrz©dn¥ x punktu: ');
    readln(k1);
  until (k1 < KWADRAT) and (k1 >= 0);
  repeat
    write('Podaj wsp¢ˆrz©dn¥ y punktu: ');
    readln(l1);
  until (l1 < KWADRAT) and (l1 >=0);
  pr:=0;
  for it:=1 to ITERACJE do
    begin
      k:=k1;
      l:=l1;
      Start1;
    end;
  for i:=0 to KWADRAT-1 do
    begin
      for j:=0 to KWADRAT-1 do
        begin
          pr:=pr+tabl[i,j];
        end;
    end;
  for i:=0 to KWADRAT-1 do
    begin
      for j:=0 to KWADRAT-1 do
        begin
          writeln('(',i,',',j,')',': ',tabl[i,j]/pr:12:12);
          writeln(f,tabl[i,j]/pr:12:12);
        end;
    end;
end;

procedure Main2;

var
  it,i,j : integer;
  pr : longint;

begin
  pr:=0;
  for it:=1 to ITERACJE do
    begin
      Start2;
    end;
  for i:=0 to KWADRAT-1 do
    begin
      for j:=0 to KWADRAT-1 do
        begin
          pr:=pr+tabl[i,j];
        end;
    end;
  for i:=0 to KWADRAT-1 do
    begin
      for j:=0 to KWADRAT-1 do
        begin
          writeln('(',i,',',j,')',': ',tabl[i,j]/pr:12:12);
          writeln(f,tabl[i,j]/pr:12:12);
        end;
    end;
end;

procedure Main3;

var
  it,i,j : integer;
  pr : longint;
  x,y : integer;

begin
  repeat
    write('Podaj liczb© punkt¢w: ');
    readln(liczba)
  until (liczba < KWADRAT) and (liczba > 0);
  for i:=0 to liczba-1 do
    begin
      repeat
        write('Podaj wsp¢ˆrz©dn¥ x punktu: ');
        readln(x);
      until (x < KWADRAT) and (x >= 0);
      wspx[i]:=x;
      repeat
        write('Podaj wsp¢ˆrz©dn¥ y punktu: ');
        readln(y);
      until (y < KWADRAT) and (y >= 0);
      wspy[i]:=y;
    end;
  pr:=0;
  for it:=1 to ITERACJE do
    begin
      Start3;
    end;
  for i:=0 to KWADRAT-1 do
    begin
      for j:=0 to KWADRAT-1 do
        begin
          pr:=pr+tabl[i,j];
        end;
    end;
  for i:=0 to KWADRAT-1 do
    begin
      for j:=0 to KWADRAT-1 do
        begin
          writeln('(',i,',',j,')',': ',tabl[i,j]/pr:12:12);
          writeln(f,tabl[i,j]/pr:12:12);
        end;
    end;
end;

procedure Main;

var
  ch : char;

begin
  ClrScr;
  writeln('Graficzny Symulator Bˆ¥dzenia Przypadkowego rev 1.2');
  writeln('(C) 1999 by Przemysˆaw Frasunek <venglin@lagoon.freebsd.org.pl>');
  writeln;
  writeln('Podaj rozkˆad prawdopodobieästwa:');
  writeln('a) Rozkˆad skupiony w punkcie (a,b)');
  writeln('b) Rozkˆad r¢wnomierny');
  writeln('c) Rozkˆad skupiony w kilku zadanych punktach');
  repeat
    ch:=readkey;
  until ch in ['a','b','c'];
  FillChar(tabl,SizeOf(tabl),0);
  assign(f,'dane.txt');
  rewrite(f);
  writeln;
  case ch of
    'a' : Main1;
    'b' : Main2;
    'c' : Main3;
  end;
  close(f);
end;

begin
  Main;
end.
