PROGRAM FRAKTAL_7;
{
  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
  x,y:integer;
  f_x:array[0..1279]of byte;
  f_y:array[0..1023]of byte;
  r,rc:real;
  b,v,c,cc:byte;
  ch,th:char;
  d:boolean;
  s:string;

{----------------------------------------------------------------------------}
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(b:byte);
BEGIN
  for x:=  0 to  63 do setpal(x+b,63,63-x,0);
  for x:= 64 to 127 do setpal(x+b,63-(x-64),(x-64),0);
  for x:=128 to 191 do setpal(x+b,0,63-(x-128),(x-128));
  for x:=192 to 255 do setpal(x+b,(x-192),(x-192),63-(x-192));
END;

{----------------------------------------------------------------------------}
PROCEDURE FRAKTAL;
BEGIN
  if d then
  begin
    for x:=0 to getmaxx do f_x[x]:=trunc((cos(pi*x/160)+1)*127.5);
    for x:=0 to getmaxy do f_y[x]:=trunc((cos(pi*x/100)+1)*127.5);
  end else
  begin
    for x:=0 to getmaxx do f_x[x]:=trunc((sin(pi*x/160)+1)*127.5);
    for x:=0 to getmaxy do f_y[x]:=trunc((sin(pi*x/100)+1)*127.5);
  end;
END;

{----------------------------------------------------------------------------}
BEGIN
  writeln;
  writeln;
  write('ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»');
  write('º FRAKTAL 7                                              (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(x);
  delay(100);
  initgraph(x);

  palette(0);
  fraktal;

  r:=1;
  rc:=0.01;
  b:=0;
  v:=0;
  c:=0;
  cc:=0;
  ch:=#0;
  th:=#0;
  repeat
    r:=r+rc;
    for y:=0 to getmaxy do
    begin
      inc(c);
      if c>=cc then
      begin
        inc(b);
        palette(b);
        c:=0;
      end;
      for x:=0 to getmaxx do putpixel(x,y,trunc(f_x[x]*r+f_y[y]*r));
      if keypressed then
      begin
        ch:=readkey;
        case ch of
          '+': begin if v>0 then dec(v); str(v,s); outtextxy(5,5,'Geschwindigkeit: '+s) end;
          '-': begin if v<255 then inc(v); str(v,s); outtextxy(5,5,'Geschwindigkeit: '+s) end;
          '/': begin rc:=rc+0.01; str(rc:6:2,s); outtextxy(5,5,'Fraktalver„nderung: '+s) end;
          '*': begin if rc>=0.01 then rc:=rc-0.01; str(rc:6:2,s); outtextxy(5,5,'Fraktalver„nderung: '+s) end;
          #32: begin d:=not d; fraktal; end;
          #00: th:=readkey;
        end;
        case th of
          #82: begin if cc>0 then dec(cc); str(cc,s); outtextxy(5,5,'Farbver„nderung: '+s) end;
          #83: begin if cc<100 then inc(cc); str(cc,s); outtextxy(5,5,'Farbver„nderung: '+s) end;
        end;
      end;
      delay(v);
      if ch=#27 then y:=getmaxy;
    end;
  until ch=#27;

  closegraph;
END.