// Fraktale - zbiory Mandelbar i jego wyzsze rzedy
// www.algorytm.org
// Tomasz Lubinski (c) 2009

unit Mandelbar;

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;
    powerLevel: TComboBox;
    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;

  PPixelRec = ^TPixelRec;
  TPixelRec = packed record
    B: Byte;
    G: Byte;
    R: Byte;
    Reserved: Byte;
  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 TPixelRec;
//---------------------------------------------------------------------------

//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.6*i, 0.85, 0.6, r, g, b);
                colors[i].r :=  Round(r*255);
                colors[i].g :=  Round(g*255);
                colors[i].b :=  Round(b*255);
        end;
        colors[120].r := 0;
        colors[120].g := 0;
        colors[120].b := 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) = conjugate(z^level) + p
function g(z: complex_t; level: Integer; p: complex_t): complex_t;
var
        i: Integer;
        tmp: complex_t;
begin

        Result := z;
        for i:=1 to level-1 do
        begin
                tmp.real := result.real*z.real - result.imaginary*z.imaginary;
                tmp.imaginary := result.real*z.imaginary + result.imaginary*z.real;
                result := tmp;
        end;

        Result.real := Result.real + p.real;
        Result.imaginary := - Result.imaginary + p.imaginary;
end;

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

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

        Result := iteration;
end;


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

        powLevel :=  powerLevel.ItemIndex + 2;

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

        Fractal.Canvas.Brush.Color := clWhite;
        Fractal.Canvas.Rectangle(0, 0, Fractal.Width, Fractal.Height);
        Fractal.Picture.Bitmap.PixelFormat := pf32Bit;

        for i:=0 to Fractal.Height-1 do
        begin
                pixel := Fractal.Picture.Bitmap.ScanLine[i];
                p.imaginary := i*ratioY + min_Y;
                for j:=0 to Fractal.Width-1 do
                begin
                        p.real := j*ratioX + min_X;
                        level := levelSet(p, powLevel);
                        pixel.r := colors[level].r;
                        pixel.g := colors[level].g;
                        pixel.b := colors[level].b;
                        Inc(pixel);
                end;

        end;
        Fractal.Refresh();

end;

procedure TForm1.FormCreate(Sender: TObject);
begin
        minx.Text := FloatToStr(-1.5);
        maxx.Text := FloatToStr(1.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;

        powerLevel.ItemIndex := 0;

        //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.