Home > Programming > Fractals > Forrest

 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 Forrest(ABitmap: TBitmap); { compute and display forest of trees   using Michael Barnsley's IFS algorithm } var    x, y      : double;          { pixel coordinates }    i, j      : integer;       { loop counters}    q         : integer;       { random number }    k         : integer;       { row selector }    MaxX,    MaxY      : integer;      { Maximum X screen coordinate}    d         : array[1..4,1..6] of double; { holds data of IFS attractor }    scale     : double;          { random scale factor}    xpos,ypos : integer;      { tree position }    crand     : integer;       { pick random color (green, blue, yellow) }    color     : integer;       { random color value }    Rect      : TRect;    curColor  : TColorRef;    Iterations: integer;    xValue,    yValue    : integer;    xScale,    yScale : double; 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;     MaxX := Max(MaxX,MaxY);     MaxY := MaxX; { initialize IFS data array }     d[1,1]:=0;     d[1,2]:=0;     d[1,3]:=0;      d[1,4]:=0.5;  d[1,5]:=0; d[1,6]:=0;     d[2,1]:=0.42;  d[2,2]:=-0.42; d[2,3]:=0.42;  d[2,4]:=0.42; d[2,5]:=0; d[2,6]:=0.2;     d[3,1]:=0.42;  d[3,2]:=0.42;  d[3,3]:=-0.42; d[3,4]:=0.42; d[3,5]:=0; d[3,6]:=0.2;     d[4,1]:=0.1;   d[4,2]:=0;     d[4,3]:=0;      d[4,4]:=0.1;  d[4,5]:=0; d[4,6]:=0.2;     x := 0;               {set starting coordinates}     y := 0;     Iterations := trunc(MaxY/20 * 50);     for j := 1 to 20 do                        { make 20 trees }     begin       xpos := random(MaxX);                     { pick tree position }       ypos := random(MaxX);       scale := MaxY/(random(3) + 1);           { pick tree scale }       crand := random(10) + 1;                  { pick tree color }       case  crand of         0,1,2,3,4,5,6,7,8:              color := GREEN;                   { most trees are green }         9  : color := YELLOW;                  { some trees are yellow }         10 : color := BROWN;                   { some trees die }       else         color := WHITE;       end;       curColor :=  GetRGBColor(color);       for i := 1 to 10 do                      { skip first 10 iterations }       begin         q := random(100) + 1;                 { pick random number from 1-100}         if q <= 40 then                       { assign row according to }           k := 2                              { probability }         else if (q> 40) AND (q < 81) then           k := 3         else if (q >= 81) AND (q < 95) then           k := 4         else           k := 1;         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            { Iterations pixels per tree }       begin         q := random(100) + 1;                 { pick random number from 1-100}         if q <= 40 then                       { assign row according to }           k := 2                              { probability }         else           if (q> 40) AND (q < 81) then             k := 3           else           if (q >= 81) AND (q < 95) then            k := 4          else          if (q >= 95 ) then            k := 1;          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];          xScale := x*scale;          yScale := y*Scale;          if (xScale<maxLong) and (yScale<maxLong) then          begin            xValue := xpos + round(xScale);            yValue := ypos - round(yScale);            ABitmap.Canvas.Pixels[xValue + Left,yValue + top] := curColor;          end;        end;      end;   end; end; //////////////////////////////////////////////////////////////////////////////// ```