PROGRAM FRAKTAL_1;
{
  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,DOS,GRAPH,MAIN;

VAR
  j: byte;
  rauheit:real;
  incdec:boolean;
  ch:char;
  RATE:INTEGER;

{²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²}
PROCEDURE FRAKTAL1;
{-------------------------------------}
procedure NewCol(xa, ya, x, y, xb, yb:Integer);
var col: integer;
begin
  col:= Abs(xa - xb) + Abs(ya - yb);
  col:= Round(Random(col)*Rauheit)-col;
  col:= (col+GetPixel(xa,ya)+GetPixel(xb,yb)) div 2;
  if col < 1 then col:=1;
  if col >180 then col:=180;
  if Getpixel(x,y) = 0 then PutPixel(x,y,col);
end;
{-------------------------------------}
procedure SetPalette(j: byte);
var i: byte;
begin
  for i:= 1 to 63 do
  begin
    Setpal(i + j, 0, 63 -i, i);
    Setpal(i + 63 + j, i, 0, 63 - i);
    Setpal(i + 126 + j, 63 - i, i, 0);
  end;
end;
{-------------------------------------}
procedure SubDivide(x1,y1,x2,y2:word);
var col:integer;
  x,y:word;
begin
  if (not((x2-x1<2)and(y2-y1<2)))and(not keypressed)then
  begin
    x:= (x1 + x2) div 2;
    y:= (y1 + y2) div 2;
    NewCol(x1, y1, x, y1, x2, y1);
    NewCol(x2, y1, x2, y, x2, y2);
    NewCol(x1, y2, x, y2, x2, y2);
    NewCol(x1, y1, x1, y, x1, y2);
    col:=(GetPixel(x1,y1)+GetPixel(x2,y2)+GetPixel(x2,y1)+GetPixel(x1,y2))div 4;
    PutPixel(x,y,col);
    SubDivide(x1, y1, x, y);
    SubDivide(x, y1, x2, y);
    SubDivide(x, y, x2, y2);
    SubDivide(x1, y, x, y2);
  end;
end;
{-------------------------------------}
VAR x,y:integer;
BEGIN
  randomize;
  Rauheit:=(random({99}9)+21)/10;
  j:=random(2);
  if j=0 then incdec:=true else incdec:=false;

  SetPalette(0);

  j:=random(11)+1;
  for x:=0 to 639 do for y:=0 to 479 do putpixel(x,y,abs(((sqr(y-240)+sqr(x-320))shr j mod 127)-63)+16);

  ch:=#0;
  repeat
    SetPalette(j);
    if incdec then inc(j) else dec(j);

    delay(rate);

    if keypressed then
    begin
      ch:=readkey;
      case ch of
        '+': if rate>0 then dec(rate);
        '-': inc(rate);
        #27:;
      end;
    end;
  until ch=#27;
END;

{²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²}
BEGIN
  rate:=30;
  initgr;

  fraktal1;

  closegraph;
END.
