PROGRAM FRAKTAL_6;
{
  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

  note: to compile this source you must have at least
        Borland Pascal 7 or above (Free Pascal Compiler > 0.98)
}

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:=  0 to  41 do setpal(x+i*2,22+x,22+x,48);
  for x:= 42 to  96 do setpal(x+i*2,63-(x-42),63-(x-42),48);
  for x:= 97 to 128 do setpal(x+i*2,9+(x-97),9,48-(x-97));
  for x:=129 to 156 do setpal(x+i*2,40,9+(x-129),17);
  for x:=157 to 188 do setpal(x+i*2,40,36,17+(x-157));
  for x:=189 to 216 do setpal(x+i*2,40,36+(x-189),48);
  for x:=217 to 255 do setpal(x+i*2,40-((x-217)div 2),63-(x-217),48);
END;

{----------------------------------------------------------------------------}
PROCEDURE FRAKTAL(b:byte);
VAR
  i:longint;
  c:byte;
BEGIN
  c:=random(5)+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(y*x*x/256*c));
      2:putpixel(x,y,round(y*arctan(x)*256*5.44*pi*c));
      3:putpixel(x,y,y+x+x+x+x+x*y*y div (256 div c));
      4:putpixel(x,y,y+x*x div (256 div c));
    end;

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

{----------------------------------------------------------------------------}
BEGIN
  randomize;
  writeln;
  writeln;
  write('ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»');
  write('º FRAKTAL 6                                              (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(4)+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(4)+1; fraktal(x); end;
      end;
    end;
    delay(geschwindigkeit);
  until (ch=#27);

  closegraph;
END.