Home > Programming > Fractals > Maze

 Previous Next

```const    escape=4.0;                { escape value }    attract=0.0001;            { attractor sensitivity } const    Black        = 0;    Blue         = 1;    Green        = 2;    Cyan         = 3;    Red          = 4;    Magenta      = 5;    Brown        = 6;    LightGray    = 7;    DarkGray     = 8;    LightBlue    = 9;    LightGreen   =10;    LightCyan    =11;    LightRed     =12;    LightMagenta =13;    Yellow       =14;    White        =15; function GetRGBColor(color:byte):longint; begin   case Color of     black : GetRGBColor := RGB(0,0,0);     blue  : GetRGBColor := RGB(0,0,128);     green : GetRGBColor := RGB(0,128,0);     cyan  : GetRGBColor := RGB(0,255,255);     red   : GetRGBColor := RGB(128,0,0);     magenta : GetRGBColor := RGB(128,0,128);     brown : GetRGBColor := RGB(128,128,0);     lightgray : GetRGBColor := RGB(192,192,192);     darkgray : GetRGBColor := RGB(128,128,128);     lightBlue : GetRGBColor := RGB(0,0,255);     lightGreen : GetRGBColor := RGB(0,255,0);     lightcyan : GetRGBColor := RGB(0,255,255);     lightRed : GetRGBColor := RGB(255,0,0);     lightmagenta : GetRGBColor := RGB(255,0,255);     yellow: GetRGBColor := RGB(255,255,0);     white : GetRGBColor := RGB(255,255,255);   else     GetRGBColor := RGB(0,0,255);   end; end; //////////////////////////////////////////////////////////////////////////////// procedure Maze(ABitmap: TBitmap); { compute and display a "maze"   using Michael Barnsley's IFS algorithm } var    x, y      : double;        { pixel coordinates }    i         : integer;       { loop counters}    k         : integer;       { row selector }    d         : array[1..6,1..6] of double; { holds data of IFS attractor }    Rect      : TRect;    Multiplier : double;    Iterations : word;    MaxX,    MaxY : integer;    xValue,    yValue   : integer; begin   SetRect(Rect, 0, 0, ABitmap.Width, ABitmap.Height);   with Rect do   begin     MaxX := right - left;     MaxY := bottom - top;     { find maximum Y coordinate }     if (MaxX=0) or (MaxY=0) then exit;     MaxY := Max(MaxX,MaxY);     bottom := top + MaxY;     right  := left + MaxY; { initialize IFS data array }     d[1,1]:=0.33; d[1,2]:=0; d[1,3]:=0; d[1,4]:=0.33; d[1,5]:=1;  d[1,6]:=1;     d[2,1]:=0.33; d[2,2]:=0; d[2,3]:=0; d[2,4]:=0.33; d[2,5]:=MaxY div 2; d[2,6]:=1;     d[3,1]:=0.33; d[3,2]:=0; d[3,3]:=0; d[3,4]:=0.33; d[3,5]:=1;  d[3,6]:=MaxY div 2;     d[4,1]:=0.33; d[4,2]:=0; d[4,3]:=0; d[4,4]:=0.33; d[4,5]:=MaxY div 2; d[4,6]:=MaxY;     d[5,1]:=0.33; d[5,2]:=0; d[5,3]:=0; d[5,4]:=0.33; d[5,5]:=MaxY; d[5,6]:=MaxY;     d[6,1]:=0.33; d[6,2]:=0; d[6,3]:=0; d[6,4]:=0.33; d[6,5]:=1; d[6,6]:=MaxY;     x := 0;               {set starting coordinates}     y := 0;     Iterations := MaxY * 50;     Multiplier := 2/3;     for i := 1 to 10 do                     { skip first 10 iterations }     begin       k := random(6) + 1;                   { pick random row }       x := d[k,1]*x + d[k,2]*y + d[k,5];   { transform coordinates }       y := d[k,3]*x + d[k,4]*y + d[k,6];     end;     for i := 11 to Iterations do     begin       k := random(6) + 1;                   { pick random row }       x := d[k,1]*x + d[k,2]*y + d[k,5];   { transform coordinates }       y := d[k,3]*x + d[k,4]*y + d[k,6];       xValue := round(x*Multiplier)+Left;       yValue := round(y*Multiplier);       ABitmap.Canvas.Pixels[xValue,yValue+top] := ABitmap.Canvas.Pen.Color;       ABitmap.Canvas.Pixels[xValue,bottom-yValue] := ABitmap.Canvas.Pen.Color;     end;   end; end; //////////////////////////////////////////////////////////////////////////////// ```