program fraktal_3;
{
  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;

const origmode=0;

var c,cc,j,k,i:integer;
  randomizer:byte;
  schnelligkeit:byte;
  ch:char;
var cr,cg,cb: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
  if randomizer=1 then
  begin
    for c:=  1   to  41   do setpal(c+b*2,63,63          ,22+c        );
    for c:= 42   to  43   do setpal(c+b*2,63,63          ,63          );
    for c:= 44   to  64   do setpal(c+b*2,63-(c-1)+42,64-(c*2)+22 ,63);
    for c:= 65   to 128   do setpal(c+b*2,42,c-65        ,63          );
    for c:=129   to 169   do setpal(c+b*2,42-c-65,c-129 xor 63,c-129 xor 63);
    for c:=170   to 192   do setpal(c+b*2,42-c-129 xor 63,c-129 xor 63,c-193 xor 63);
    for c:=193   to 233   do setpal(c+b*2,23+c-193,c-193       ,0                  );
    for c:=234   to 256   do setpal(c+b*2,63,c-193       ,c-234                    );
  end;
  if randomizer=2 then
  begin
    for c:=  1   to  41   do setpal(c+b*2,63          ,22+c        ,63);
    for c:= 42   to  43   do setpal(c+b*2,63          ,63          ,63);
    for c:= 44   to  64   do setpal(c+b*2,64-(c*2)+22 ,63          ,63-(c-1)+42);
    for c:= 65   to 128   do setpal(c+b*2,c-65        ,63          ,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-129 xor 63,c-193 xor 63,42-c-129 xor 63);
    for c:=193   to 233   do setpal(c+b*2,c-193       ,0           ,23+c-193       );
    for c:=234   to 256   do setpal(c+b*2,c-193       ,c-234       ,63             );
  end;
  if randomizer=3 then
  begin
    for c:=  1   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;
  if randomizer=4 then
  begin
    for c:=  0   to  41   do setpal(c+b*2,63          ,63,22+c        );
    for c:= 42   to  43   do setpal(c+b*2,63          ,63,63          );
    for c:= 44   to  64   do setpal(c+b*2,64-(c*2)+22 ,63-(c-1)+42,63          );
    for c:= 65   to 128   do setpal(c+b*2,c-65        ,42,63          );
    for c:=129   to 169   do setpal(c+b*2,c-129 xor 63,42-c-65,c-129 xor 63);
    for c:=170   to 192   do setpal(c+b*2,c-129 xor 63,42-c-129 xor 63,c-193 xor 63);
    for c:=193   to 233   do setpal(c+b*2,c-193       ,23+c-193       ,0           );
    for c:=234   to 256   do setpal(c+b*2,c-193       ,63             ,c-234       );
  end;
end;

{@def_asm}
procedure wait(s:word);
var ms:word;
begin
  asm
    mov  ax,1000
    mul  s
    mov  cx,dx
    mov  dx,ax
    mov  ah,$86
    int  $15
  end;
end;

{@def_main}
begin
  setint(19);
  randomize;
  randomizer:=random(4)+1;
  cr:=random(3)+1;
  repeat cg:=random(3)+1; until cg<>cr;
  repeat cb:=random(3)+1; until cb<>(cr)and(cg);
  setrgb(origmode);
  for c:=0 to 181 do for k:=0 to 319 do mem[$A000:k+320*(c+1)]:=round(k+c*c/60);
  schnelligkeit:=8;
  i:=0;
  j:=random(2);
  ch:=#0;
  repeat
    if j=1 then inc(i);
    if j=0 then dec(i);
    setrgb(i);
    if keypressed then
    begin
      ch:=readkey;
      case ch of
        '+': if schnelligkeit>0   then dec(schnelligkeit);
        '-': if schnelligkeit<255 then inc(schnelligkeit);
      end;
    end;
    wait(schnelligkeit);
  until ch=#27;
  setint(3);
end.