program fraktal_4;
{
  programmed by Kristian Peters
  (c) Copyright 1995-2004 Korseby

  released under the terms of GPL

  contact: kristian.peters@korseby.net
  web: http://www.korseby.net
}

uses crt;

var
  c,k,i:integer;
  ch:char;
  geschwindigkeit:byte;

{@def_asm}
procedure setint(b:shortint);
begin
  asm;
    mov         ah,0
    mov         al,b
    int         16
  end;
end;

{def_proc}
procedure setpal(c:byte;r,g,b:shortint);
begin
  port[$3C8]:=c;
  port[$3C9]:=r;
  port[$3C9]:=g;
  port[$3C9]:=b;
end;

{@def_proc}
procedure setrgb(b:byte);
begin
  for c:=  0   to  41   do setpal(c+b*2,22+c        ,63          ,63);
  for c:= 42   to  43   do setpal(c+b*2,63          ,63          ,63);
  for c:= 44   to  64   do setpal(c+b*2,63          ,64-(c*2)+22 ,63-(c-1)+42);
  for c:= 65   to 128   do setpal(c+b*2,63          ,c-65        ,42);
  for c:=129   to 169   do setpal(c+b*2,c-129 xor 63,c-129 xor 63,42-c-65);
  for c:=170   to 192   do setpal(c+b*2,c-193 xor 63,c-129 xor 63,42-c-129 xor 63);
  for c:=193   to 233   do setpal(c+b*2,0           ,c-193       ,23+c-193       );
  for c:=234   to 256   do setpal(c+b*2,c-234       ,c-193       ,63             );
end;

procedure mainproc;
begin
  i:=random(16)+1;

  case i of
     1:for c:=0 to 199 do for k:=0 to 319 do mem[$A000:k+320*(c+1)]:=round(c*c/30)*k;
     2:for c:=0 to 199 do for k:=0 to 319 do mem[$A000:k+320*(c+1)]:=round(k+c*c/60)*k;
     3:for c:=0 to 181 do for k:=0 to 319 do mem[$A000:k+320*(c+1)]:=round(k+c*c/60);
     4:for c:=0 to 199 do for k:=0 to 319 do mem[$A000:k+320*(c+1)]:=round(c*c+k);
     5:for c:=0 to 199 do for k:=0 to 319 do mem[$A000:k+320*(c+1)]:=round(c*k);
     6:for c:=0 to 199 do for k:=0 to 319 do mem[$A000:k+320*(c+1)]:=round(c/-(k+1)*105);
     7:for c:=0 to 199 do for k:=0 to 219 do mem[$A000:k+320*(c+1)]:=round(c/-(k*k+1)*457);
     8:for c:=0 to 199 do for k:=0 to 319 do mem[$A000:k+320*(c+1)]:=round(c/-sin(k*k+1));
     9:for c:=0 to 199 do for k:=0 to 319 do mem[$A000:k+320*(c+1)]:=round(sin(c*k)*c);
    10:for c:=0 to 199 do for k:=0 to 319 do mem[$A000:k+320*(c+1)]:=round(sin(c/(k+1))*k);
    11:for c:=80 to 279 do for k:=0 to 319 do mem[$A000:k+320*(c+1-80)]:=round(sin(c/(k+1))*c);
    12:for c:=0 to 199 do for k:=0 to 319 do mem[$A000:k+320*(c+1)]:=round(sin(k/(c*9+1))*k) xor 255;
    13:for c:=200 to 399 do for k:=0 to 319 do mem[$A000:k+320*(c+1-200)]:=round(sin(k/(c*9+1))*k) xor 255;
    14:for c:=200 to 399 do for k:=0 to 319 do mem[$A000:k+320*(c+1-200)]:=-round(sin(k/(c*9+1))*k)-67;
    15:for c:=200 to 399 do for k:=0 to 319 do mem[$A000:k+320*(c+1-200)]:=round(sin(k/(c*9+1))*k)+67;
    16:begin
         i:=5;
         repeat
           inc(i);
           for c:=0 to 199 do for k:=0 to 319 do mem[$A000:k+320*(c+1)]:=round(k/(c+1)*i);
         until (keypressed)or(i>=57);
       end;
  end;

  i:=0;
  ch:=#0;
  geschwindigkeit:=0;
  repeat
    inc(i);
    setrgb(i);
    if keypressed then
    begin
      ch:=readkey;
      case ch of
        '+':if geschwindigkeit>0 then dec(geschwindigkeit);
        '-':if geschwindigkeit<255 then inc(geschwindigkeit);
      end;
    end;
    delay(geschwindigkeit);
  until (ch>#0)and(ch<>'+')and(ch<>'-');
end;

begin
  randomize;
  setint(19);
  setrgb(0);

  ch:=#0;
  repeat
    mainproc;
  until ch=#27;

  setint(3);
end.