program    berg;
(* Programmiert von Martin Frankl *)
const
 farbe=15;
 c80=3;

var
 d,r,s,t,i,k,s1,za,dk,rx,ii,rxx  : integer;
 faktorxx,faktoryy,xm,ym,ry,ryy  : integer;
 x,y                             : array[0..128,0..128] of byte;
 mx,my                           : byte;
 key,tat                         : char;

procedure zeichnung;
begin
 clrscr;
 hires;
 t:=0;
 i:=0;
 repeat
    repeat
       draw(2*x[i,t],y[i,t],2*x[i+s,t],y[i+s,t],farbe);
       i:=i+s;
    until i>d-t-s;
    i:=0;
    t:=t+s;
 until t>d-s;
 t:=0;
 i:=0;
 repeat
    repeat
       draw(2*x[t,i],y[t,i],2*x[t,i+s],y[t,i+s],farbe);
       i:=i+s;
    until i>d-t-s;
    i:=0;
    t:=t+s;
 until t>d-s;
 t:=0;
 i:=s;
 if tat='n' then
  begin
   repeat
     repeat
        draw(2*x[i,t],y[i,t],2*x[i-s,t+s],y[i-s,t+s],farbe);
        i:=i+s;
     until i>d-t;
     i:=s;
     t:=t+s;
   until t>d-s;
  end;
end;


procedure zwischen;
begin
 s1:=s div 2;
 t:=0;
 i:=0;
 repeat
    repeat
       x[t+s1,i]:=(x[t,i]+x[t+s,i])div 2;
       y[t+s1,i]:=(y[t,i]+y[t+s,i])div 2;
       i:=i+s;
    until i>d-t-s;
    i:=0;
    t:=t+s;
 until t>d-s;
 t:=0;
 i:=0;
 repeat
    repeat
       x[i,t+s1]:=(x[i,t]+x[i,t+s])div 2;
       y[i,t+s1]:=(y[i,t]+y[i,t+s])div 2;
       i:=i+s;
    until i>d-t-s;
    i:=0;
    t:=t+s;
 until t>d-s;
 t:=0;
 i:=0;
 repeat
    repeat
       x[i-s1,t+s1]:=(x[i,t]+x[i-s,t+s])div 2;
       y[i-s1,t+s1]:=(y[i,t]+y[i-s,t+s])div 2;
       i:=i+s;
    until i>d-t;
    i:=s;
    t:=t+s;
 until t>d-s;
 s:=s1;
end;

procedure verschiebung;
begin
 t:=0;
 i:=0;
 repeat
    repeat
       xm:=x[t,i];
       ym:=y[t,i];
       x[t,i]:=x[t,i]  +random(rxx)-(rxx div 2);
       y[t,i]:=y[t,i]  +random(ryy)-(ryy div 2);
       if abs(x[t,i]-xm)>rxx/1.8 then x[t,i]:=xm;
       if abs(y[t,i]-ym)>ryy/1.8 then y[t,i]:=ym;
       if y[t,i]<10  then y[t,i]:=10;
       if y[t,i]>199 then y[t,i]:=199;
       if x[t,i]<10  then x[t,i]:=10;
       if x[t,i]>245 then x[t,i]:=245;
       i:=i+s;
    until i>d-t;
    i:=0;
    t:=t+s;
 until t>d;
 rxx:=rxx div faktorxx;
 ryy:=ryy div faktoryy;
 if rxx=0 then rxx:=1;
 if ryy=0 then ryy:=1;
end;

procedure koeff;
begin
 textmode(c80);
 clrscr;
 write('Versetzung in y- Richtung : ');
 read(ry);
 if ry=0 then ry:=1;
 repeat
    writeln;
    write('Faktor fuer y- Richtung : ');
    read(faktoryy);
 until faktoryy<>0;
 writeln;
 write('Versetzung in x- Richtung : ');
 read(rx);
 if rx=0 then rx:=1;
 repeat
    writeln;
    write('Faktor fuer x- Richtung : ');
    read(faktorxx);
 until faktorxx<>0;
 writeln;
 write('Waagrechte - Linie (j/n) : ');
 read(tat)
end;


begin
dk:=64;
rx:=1;
tat:='n';
faktorxx:=1;
ry:=30;
faktoryy:=2;
repeat
   d:=dk;
   rxx:=rx;
   ryy:=ry;
   s:=d div 2;
   x[d,0]:=5;
   y[d,0]:=190;
   x[s,s]:=127;
   y[s,s]:=190;
   x[0,d]:=250;
   y[0,d]:=190;
   x[s,0]:=66;
   y[s,0]:=100;
   x[0,s]:=193;
   y[0,s]:=100;
   x[0,0]:=127;
   y[0,0]:=10;
   repeat
      zwischen;
      Verschiebung;
      zeichnung;
      read(key);
      if key='i' then koeff;
   until (s=1) or (key='n') or (key='i');
until key='n';
textmode(c80);
clrscr;
end.
