PROGRAM FRAKTAL_5;
{
  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,GRAPH;

VAR
  i,x,y:integer;
  ch:char;
  geschwindigkeit:byte;

{----------------------------------------------------------------------------}
PROCEDURE INITGRAPH(b:integer);
VAR
  a:integer;
BEGIN
  a:=installuserdriver('SVGA256M',nil);
  graph.initgraph(a,b,'');
  b:=graphresult;
  if b<>grok then
  begin
    clrscr;
    writeln('Grafikmodus wurde nicht initialisiert.');
    writeln(grapherrormsg(b));
    halt;
  end;
END;

{----------------------------------------------------------------------------}
PROCEDURE SETPAL(c:byte;r,g,b:shortint);
BEGIN
  if r>63 then r:=63;
  if r<0  then r:=0;
  if g>63 then g:=63;
  if g<0  then g:=0;
  if b>63 then b:=63;
  if b<0  then b:=0;
  setrgbpalette(c,r,g,b);
END;

{----------------------------------------------------------------------------}
PROCEDURE PALETTE(i:integer);
BEGIN
  for x:=  1 to  31 do setpal(x+i*2,0+x,0+x,36);
  for x:= 31 to  63 do setpal(x+i*2,31-(x-31),31-(x-31),36+((x-31)div 2));
  for x:= 64 to 116 do setpal(x+i*2,0+(x-64),0+((x-64)),52);
  for x:=117 to 127 do setpal(x+i*2,0+(x-64),0+((x-64)),52+(x-117));
  for x:=128 to 159 do setpal(x+i*2,63-(x-128),63-(x-128),63);
  for x:=160 to 191 do setpal(x+i*2,63-(x-128),63-(x-128),63-(x-160));
  for x:=192 to 223 do setpal(x+i*2,0+(x-192),0+(x-192),32);
  for x:=224 to 255 do setpal(x+i*2,32-(x-224),32-(x-224),32+((x-224)div 8));
END;

{----------------------------------------------------------------------------}
PROCEDURE FRAKTAL(b:byte);
VAR
  i:longint;
  c:byte;
BEGIN
  c:=random(3)+1;
  i:=0;
  for x:=0 to getmaxx do
    for y:=0 to getmaxy do
  begin
    dec(i);
    case b of
      1:putpixel(x,y,round(sin(pi*i*y/(x+4096)/128/c)*42)+128);
      2:putpixel(x,y,round(sin(pi*i/128)*512/c)+128);
      3:putpixel(x,y,round(sin(i*y/((x*c)+1))*42)+128);
      4:putpixel(x,y,round(cos((i/(y+1))*((x/(c*2))+1))*42)+128);
      5:putpixel(x,y,round(cos((i/(y+1))*((x/(c*20))+1))*42)+128);
      6:putpixel(x,y,round(cos((i/(y+1))*((x/(c*200))+1))*42)+128);
      7:putpixel(x,y,round(sin((i/(y*(c*200)+1))*((x)+1))*42)+128);
    end;

    if keypressed then
    begin
      x:=getmaxx;
      y:=getmaxy;
    end;
  end;
END;

{----------------------------------------------------------------------------}
BEGIN
  randomize;
  writeln;
  writeln;
  write('ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»');
  write('º FRAKTAL 5                                              (c) 1995-1999 Korseby º');
  write('ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ');
  writeln;
  writeln;
  writeln('    ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿');
  writeln('    ³ programmed by Kristian Peters                                         ³');
  writeln('    ³ (c) Copyright 1995-1999 Korseby                                       ³');
  writeln('    ³                                                                       ³');
  writeln('    ³ This program is free in use.                                          ³');
  writeln('    ³ The only thing is that you''re not allowed to distribute this program  ³');
  writeln('    ³ or make in any other sense money with it.                             ³');
  writeln('    ³                                                                       ³');
  writeln('    ³ contact: hexorre@yahoo.com                                            ³');
  writeln('    ³ web: http://www.korseby.cjb.net                                       ³');
  writeln('    ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ');
  writeln;
  writeln('Enter graphics-mode (0 = 320x200; 1 = 640x400; 2 = 640x480; 3 = 800x600;');
  write('                     4 = 1024x768; 6 = 1280x1024): ');
  readln(i);
  delay(100);
  initgraph(i);

  palette(0);

  x:=random(7)+1;
  fraktal(x);

  i:=0;
  ch:=#0;
  geschwindigkeit:=0;
  repeat
    inc(i);
    palette(i);

    if keypressed then
    begin
      ch:=readkey;
      case ch of
        '+':if geschwindigkeit>0 then dec(geschwindigkeit);
        '-':if geschwindigkeit<255 then inc(geschwindigkeit);
        #32:begin x:=random(7)+1; fraktal(x); end;
      end;
    end;
    delay(geschwindigkeit);
  until (ch=#27);

  closegraph;
END.