// Fraktale - zbior Mandelbrot'a
// www.algorytm.org
// Tomasz Lubinski (c) 2008

unit Mandelbrot;

interface

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

type
  TForm1 = class(TForm)
    Fractal: TImage;
    Label1: TLabel;
    Label2: TLabel;
    Selection: TShape;
    Label3: TLabel;
    minx: TEdit;
    maxx: TEdit;
    miny: TEdit;
    maxy: TEdit;
    Button1: TButton;
    Label6: TLabel;
    Label5: TLabel;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FractalMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FractalMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FractalMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

//type for complex numbers
type complex_t = record
    real: Extended;
    imaginary: Extended;
end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

var
//---------------------------------------------------------------------------
//Describes places to render
ratioX, ratioY :Extended;
min_X, min_Y, max_X, max_Y :Extended;
downX, downY: Integer;
//colors
colors: array[1..120] of TColor;
//---------------------------------------------------------------------------

//for HSV colors
procedure hsv2rgb(hue: double; sat: double; val: double; var red: double; var grn: double; var blu: double);
var
        i, f, p, q, t: double;
begin
        red := 0;
        grn := 0;
        blu := 0;
        if val=0 then
                begin
                        red := 0;
                        grn := 0;
                        blu := 0;
                end
        else
                begin
                        hue := hue/60;
                        i := floor(hue);
                        f := hue-i;
                        p := val*(1-sat);
                        q := val*(1-(sat*f));
                        t := val*(1-(sat*(1-f)));
                        if i=0 then begin red:=val; grn:=t; blu:=p; end
                        else if i=1 then begin red:=q; grn:=val; blu:=p; end
                        else if i=2 then begin red:=p; grn:=val; blu:=t; end
                        else if i=3 then begin red:=p; grn:=q; blu:=val; end
                        else if i=4 then begin red:=t; grn:=p; blu:=val; end
                        else if i=5 then begin red:=val; grn:=p; blu:=q; end;
                end;
end;

procedure initializeColors();
var
        i: Integer;
        r, g, b: double;
begin
        for i:=low(colors) to high(colors) do
        begin
                HSV2RGB(2.2*i, 0.85, 0.6, r, g, b);
                colors[i] :=  Round((r*255) + (Round(g*255) shl 8) + (Round(b*255) shl 16));
        end;
        colors[120] := 0;
end;

//calculate squared modus of given complex c
function complexModSq(c: complex_t): Extended;
begin
        Result := c.real*c.real + c.imaginary*c.imaginary;
end;

//function f(p)=0
function f(p: complex_t): complex_t;
begin
        Result.real := 0;
        Result.imaginary := 0;
end;

//function g(z) = z^2 + p
function g(z: complex_t; p: complex_t): complex_t;
begin
        Result.real := z.real*z.real - z.imaginary*z.imaginary + p.real;
        Result.imaginary := 2*z.real*z.imaginary + p.imaginary;
end;

//value is inside set in the returned level
function levelSet(p: complex_t): Integer;
var
        z: complex_t;
        iteration: Integer;
begin
        iteration := 0;
        z := f(p);

        repeat
                z := g(z, p);
                iteration := iteration + 1;
        until ((complexModSq(z) > 4) or (iteration > 120));

        Result := iteration;
end;


procedure TForm1.Button1Click(Sender: TObject);
var
        i, j, level: Integer;
        p: complex_t;
begin
        min_X := StrToFloat(minx.Text);
        min_Y := StrToFloat(miny.Text);
        max_X := StrToFloat(maxx.Text);
        max_Y := StrToFloat(maxy.Text);

        ratioX := (max_X - min_X) / Fractal.Width;
        ratioY := (max_Y - min_Y) / Fractal.Height;

        for i:=0 to Fractal.Height-1 do
        begin
                p.imaginary := i*ratioY + min_Y;
                for j:=0 to Fractal.Width-1 do
                begin
                        p.real := j*ratioX + min_X;
                        level := levelSet(p);
                        Fractal.Canvas.Pixels[j, i] :=  colors[level];
                end;

        end;
        Fractal.Refresh();

end;

procedure TForm1.FormCreate(Sender: TObject);
begin
        minx.Text := FloatToStr(-2.0);
        maxx.Text := FloatToStr(0.5);
        miny.Text := FloatToStr(-1.25);
        maxy.Text := FloatToStr(1.25);

        min_X := StrToFloat(minx.Text);
        min_Y := StrToFloat(miny.Text);
        max_X := StrToFloat(maxx.Text);
        max_Y := StrToFloat(maxy.Text);

        ratioX := (max_X - min_X) / Fractal.Width;
        ratioY := (max_Y - min_Y) / Fractal.Height;

        //initialize colors
        initializeColors();

        //render new fractal
        Button1Click(Sender);
end;

procedure TForm1.FractalMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
        downX := X;
        downY := Y;

        Selection.Width := 0;
        Selection.Height := 0;
        Selection.Visible := true;
end;

procedure TForm1.FractalMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
        //remove selection
        Selection.Visible := false;

        //get new range to render
        minx.Text := FloatToStr(min(downX, X)*ratioX + min_X);
        maxx.Text := FloatToStr(max(downX, X)*ratioX + min_X);
        miny.Text := FloatToStr(min(downY, Y)*ratioY + min_Y);
        maxy.Text := FloatToStr(max(downY, Y)*ratioY + min_Y);

        min_X := StrToFloat(minx.Text);
        min_Y := StrToFloat(miny.Text);
        max_X := StrToFloat(maxx.Text);
        max_Y := StrToFloat(maxy.Text);

        //render new fractal
        Button1Click(Sender);
end;

procedure TForm1.FractalMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
        //if left mouse button is held then draw selection
        if (ssLeft in Shift) then
        begin
                Selection.Width := abs(downX - X);
                Selection.Height := abs(downY - Y);
                Selection.Left := Fractal.Left + min(downX, X);
                Selection.Top := Fractal.Top + min(downY, Y);
        end;
end;

end.