unit fractal;

interface

type
   pbyte = ^byte;

   tFracdata = record
                  area_left, area_right, area_top, area_bottom : real;
                  max_iter : integer;
                  super_factor : integer;
                  field_width, field_height : integer;
                  arr_width, arr_height : integer;
               end;

var
   default_data : tFracdata;
   frac_data : tFracdata;

procedure calc_line(y : integer);
procedure plot_field(pb : pbyte; rowstride : integer);
procedure set_frac_data(fd : tFracData);

implementation

uses
   colour;

const
   DEF_MAX_ITER = 50;
   DEF_FIELD_WIDTH = 640;
   DEF_FIELD_HEIGHT = 480;
   DEF_AREA_LEFT = -2.6;
   DEF_AREA_RIGHT = 1;
   DEF_AREA_TOP = 1.35;
   DEF_AREA_BOTTOM = -1.35;
   DEF_SUPER_FACTOR = 1;
   
type
   line = array of integer;

var
   field : array of line;

procedure calc_line(y : integer);
var
   x : integer;
   cx, cy, zx, zy, zxn, zyn : real;
   step_x, step_y : real;
   
   i : integer;
begin
   step_x := (frac_data.area_right - frac_data.area_left) / frac_data.arr_width;
   step_y := (frac_data.area_top - frac_data.area_bottom) / frac_data.arr_height;
   cy := frac_data.area_bottom + y * step_y;
   cx := frac_data.area_left;
   
   for x := 0 to frac_data.arr_width - 1 do
   begin
      zx := 0;
      zy := 0;
      i := 0;
      while (zx * zx + zy * zy <= 4) and (i <= frac_data.max_iter) do
      begin
         zxn := zx * zx - zy * zy + cx;
         zyn := 2 * zx * zy + cy;
         zx := zxn;
         zy := zyn;
         inc(i);
      end;
      
      if i > frac_data.max_iter then field[y][x] := -1 else field[y][x] := i;
     
      cx := cx + step_x;
   end;
end;

procedure plot_field(pb : pbyte; rowstride : integer);
var
   x, y : integer;
   long_r, long_g, long_b : integer;
   ax, ay, sub_x, sub_y : integer;
   i : integer;
   colour : HsvColour;
   rgb : RgbColour;
begin
   rowstride := rowstride - frac_data.field_width * 3;
   
   for y := 0 to frac_data.field_height - 1 do
   begin
      for x := 0 to frac_data.field_width - 1 do
      begin
         ax := x * frac_data.super_factor;
         ay := y * frac_data.super_factor;
         long_r := 0;
         long_g := 0;
         long_b := 0;
         
         for sub_x := ax to ax + frac_data.super_factor - 1 do
            for sub_y := ay to ay + frac_data.super_factor - 1 do
            begin
               i := field[sub_y][sub_x];
               with colour do
               begin
                  if i > -1 then
                  begin
                     h := i mod 255;
                     v := 255;
                  end
                  else begin
                     h := 0;
                     v := 0;
                  end;
                  s := 255;
               end;
               rgb := hsv_to_rgb(colour);
               long_r := long_r + rgb.r;
               long_g := long_g + rgb.g;
               long_b := long_b + rgb.b;
            end;

         with rgb do
         begin
            r := long_r div (frac_data.super_factor * frac_data.super_factor);
            g := long_g div (frac_data.super_factor * frac_data.super_factor);
            b := long_b div (frac_data.super_factor * frac_data.super_factor);
         end;

         with rgb do
         begin
            pb^ := r;
            inc(pb);
            pb^ := g;
            inc(pb);
            pb^ := b;
            inc(pb);
         end;
      end;
      pb := pb + rowstride;
   end;   
end;

procedure set_frac_data(fd : tFracData);
var
   i : integer;
begin
   frac_data := fd;
   with frac_data do
   begin
      arr_width := field_width * super_factor;
      arr_height := field_height * super_factor;
      setlength(field, arr_height);
      for i := 0 to arr_height - 1 do
         setlength(field[i], arr_width);
   end;
end;

var
   i : integer;

begin
   with default_data do
   begin
      arr_width := DEF_FIELD_WIDTH * DEF_SUPER_FACTOR;
      arr_height := DEF_FIELD_HEIGHT * DEF_SUPER_FACTOR;

      field_width := DEF_FIELD_WIDTH;
      field_height := DEF_FIELD_HEIGHT;
      
      area_left := DEF_AREA_LEFT;
      area_right := DEF_AREA_RIGHT;
      area_top := DEF_AREA_TOP;
      area_bottom := DEF_AREA_BOTTOM;
   
      max_iter := DEF_MAX_ITER;
      super_factor := DEF_SUPER_FACTOR;
   
      setlength(field, arr_height);
      for i := 0 to arr_height - 1 do
         setlength(field[i], arr_width);
   end;
end.