//IFS
//(c) 2011 by Tomasz Lubinski
//www.algorytm.org

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, Math;

type
  TForm1 = class(TForm)
    Fractal: TImage;
    Label1: TLabel;
    Label2: TLabel;
    IterNum: TEdit;
    Button1: TButton;
    Fun: TComboBox;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

  // Render area coordinates
  minX: Real = -8.0;
  maxX: Real = 8.0;
  minY: Real = 11.0;
  maxY: Real = -5.0;

  // IFS data
  a, b, c, d, e, f, p: array[1..9] of Real;
  funCnt: Integer = 0;

implementation
{$R *.DFM}

// add new function to IFS
procedure addFunction(paramA, paramB, paramC, paramD, paramE, paramF, paramP: Real);
begin   
   funCnt := funCnt+1;
   if (funCnt < 9) then
   begin
      a[funCnt] := paramA;
      b[funCnt] := paramB;
      c[funCnt] := paramC;
      d[funCnt] := paramD;
      e[funCnt] := paramE;
      f[funCnt] := paramF;
      p[funCnt] := paramP;
   end;
end;

// removes all functions
procedure clearFunctions();
begin
   funCnt := 0;
end;

procedure SetFunctions();
begin
   clearFunctions();
   case Form1.Fun.ItemIndex of
      0:
         begin
         addFunction(0.5, 0.0, 0.0, 0.5, -0.5,  0.5, 0.3333);
         addFunction(0.5, 0.0, 0.0, 0.5, -0.5, -0.5, 0.3333);
         addFunction(0.5, 0.0, 0.0, 0.5,  0.5, -0.5, 0.3333);
         minX := -1.0;
         maxX := 1.0;
         minY := -1.0;
         maxY := 1.0;
         end;
      1:
         begin
         addFunction(0.787879, -0.424242, 0.242424, 0.859848,  1.758647, 1.408065, 0.895652);
         addFunction(-0.121212, 0.257576, 0.151515, 0.053030, -6.721654, 1.377236, 0.052174);
         addFunction(0.181818, -0.136364, 0.090909, 0.181818,  6.086107, 1.568035, 0.052174);
         minX := -8.0;
         maxX :=  8.0;
         minY := 11.0;
         maxY := -1.0;
         end;
      2:
         begin
         addFunction(0.824074, 0.281428, -0.212346,  0.864198, -1.882290, -0.110607, 0.787473);
         addFunction(0.088272, 0.520988, -0.463889, -0.377778,  0.785360,  8.095795, 0.212527);
         minX := -8.0;
         maxX :=  8.0;
         minY := 11.0;
         maxY := -1.0;
         end;
      4:
         begin
         addFunction(0.1400,  0.0100,  0.0000, 0.5100, -0.0800, -1.3100, 0.20);
         addFunction(0.4300,  0.5200, -0.4500, 0.5000,  1.4900, -0.7500, 0.20);
         addFunction(0.4500, -0.4900,  0.4700, 0.4700, -1.6200, -0.7400, 0.20);
         addFunction(0.4900,  0.0000,  0.0000, 0.5100,  0.0200,  1.6200, 0.40);
         minX := -5.0;
         maxX :=  5.0;
         minY :=  5.0;
         maxY := -5.0;
         end;
      5:
         begin
         addFunction( 0.0500,  0.0000,  0.0000,  0.4000, -0.0600, -0.4700, 0.142);
         addFunction(-0.0500,  0.0000,  0.0000, -0.4000, -0.0600, -0.4700, 0.142);
         addFunction( 0.0300, -0.1400,  0.0000,  0.2600, -0.1600, -0.0100, 0.142);
         addFunction(-0.0300,  0.1400,  0.0000, -0.2600, -0.1600, -0.0100, 0.142);
         addFunction( 0.5600,  0.4400, -0.3700,  0.5100,  0.3000,  0.1500, 0.142);
         addFunction( 0.1900,  0.0700, -0.1000,  0.1500, -0.2000,  0.2800, 0.142);
         addFunction(-0.3300, -0.3400, -0.3300,  0.3400, -0.5400,  0.3900, 0.142);
         minX := -1.0;
         maxX :=  1.0;
         minY :=  1.0;
         maxY := -1.0;
         end;
     else
         begin
         addFunction(0.0,   0.0,   0.0,   0.16,  0.0,  0.0,   0.01);
         addFunction(0.85,  0.04, -0.04,  0.85,  0.0,  1.6,   0.85);
         addFunction(0.2,  -0.26,  0.23,  0.22,  0.0,  1.6,   0.07);
         addFunction(-0.15, 0.28,  0.26,  0.24,  0.0,  0.44,  0.07);
         minX := -5.0;
         maxX :=  5.0;
         minY := 10.5;
         maxY :=  0.0;
         end;
     end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
   x, xtmp, y, ytmp, r: Real;
   ratioX, ratioY, prob: Real;
   i, j, n, curr, biggest, level: Integer;
   data: array of Integer;
begin
   // initialize all variables
   SetFunctions();
   ratioX := (maxX - minX) / Fractal.Width;
   ratioY := (maxY - minY) / Fractal.Height;
   SetLength(data, Fractal.Width*Fractal.Height);
   for i:=0 to (Fractal.Width*Fractal.Height)-1 do
      data[i] := 0;

   x := 0;
   y := 0;

   // Clear image
   Fractal.Canvas.Brush.Color := clWhite;
   Fractal.Canvas.Rectangle(0, 0, Fractal.Width, Fractal.Height);
   Fractal.Canvas.Brush.Color := clBlack;

   n := StrToInt(IterNum.Text);

   randomize();

   for i:=1 to n do
   begin
       // Choose random function
       r := Random;
       curr := 0;
       prob := 0;
       for j:=1 to funCnt do
       begin
          prob := prob + p[j];
          if (prob > r) then
          begin
             curr := j;
             break;
          end;
       end;

       // Perform calculation
       xtmp := a[curr]*x + b[curr]*y + e[curr];
       ytmp := c[curr]*x + d[curr]*y + f[curr];
       x := xtmp;
       y := ytmp;

       // Mark point
       Inc(data[Floor((x - minX)/ratioX) * Fractal.Width + Floor((y - minY)/ratioY)]);
   end;

   // Check range
   biggest := data[0];
   for i:=1 to (Fractal.Width*Fractal.Height)-1 do
      if (data[i] > biggest) then
         biggest := data[i];

   // Generate image
   for i:=0 to Fractal.Height-1 do
      for j:=0 to Fractal.Width-1 do
         if (data[j+i*Fractal.Width] > 0) then
         begin
            level := Floor((ln(data[j+i*Fractal.Width])/ln(biggest)) * 255);
            Fractal.Canvas.Pixels[i,j] := rgb(128-(level div 2), 255-level, 128 - (level div 2));
         end;

   Fractal.Refresh();
end;

end.