unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Image1: TImage;
    Timer1: TTimer;
    PopupMenu1: TPopupMenu;
    Exit1: TMenuItem;
    Normal1: TMenuItem;
    BlueLeaf1: TMenuItem;
    LeafOnly1: TMenuItem;
    procedure DoClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Iterate(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormKeyUp(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormShow(Sender: TObject);
    procedure Exit1Click(Sender: TObject);
    procedure PopupMenu1Popup(Sender: TObject);
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure BlueLeaf1Click(Sender: TObject);
    procedure Normal1Click(Sender: TObject);
    procedure LeafOnly1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  Base : Array of tByteArray;
  Fire,Fire2 : Array of Array[0..600] of cardinal;
  StPt,StPt2 : Array of TPoint;
  FirePos:Integer;
  Change : Array[0..1000,0..1000] of Boolean;
  Centre : Integer;
  bsSz   : Byte;
  lY : integer;
  M,N,O : Byte;
  Lno : byte;
  Iter : LongInt;
  s    : array[0..359] of ShortInt;

implementation

{$R *.DFM}

Procedure FeedNil(X : TImage);
          Var
             I,J  : Integer;
             R,W : PByteArray;
             Z   : tByteArray;
          Begin       //0=blue 1=green 2=red
               For J := 1 to X.Picture.Bitmap.Height - 2 do
               Begin
               W := X.Picture.Bitmap.ScanLine[J];
//               R := X.Picture.Bitmap.ScanLine[J];
               //IF J = X.Picture.Bitmap.Height - 1 Then R := @Base;
               //New(Z);
               For I := 0 to 4*(X.Picture.Bitmap.Width - 1) Do Z[i] := W^[I];
               If W <> nil then For I := 1 to X.Picture.Bitmap.Width - 2 Do
                   //W^[I*4+2] := ((R[I*4+2]*3+R[(I-1)*4+2]*0+R[(I+1)*4+2]) div 4) mod 256;
                   W^[I*4+2] := ( (R[I*4+2]*2+z[(I-1)*4+2]+z[(I+1)*4+2]+R[(I-1)*4+2]+R[(I+1)*4+2]) div 6) mod 256;
               End;
          End;

Procedure Feed3(X : TImage );
          Var
             I,J  : Integer;
             R,W : PByteArray;
             Z   : tByteArray;
             A,B : Integer;
          Begin       //0=blue 1=green 2=red 3=alpha
               If FirePos<X.Picture.Bitmap.Width then Inc(FirePos);
               For I := 0 to High(StPt) Do
                   Begin
                        {If stPt[i].X<=FirePos then }
                        A := StPt[I].x; B := StPt[I].y;
                        Fire[B][A*4+2] := Random(256);
                        {Fire[B][A*4+1] := Random(Fire[B][A*4+2]);
                        If Fire[B][A*4+1] > 200 Then Fire[B][A*4] := 200;}
//                        Change[StPt[i].X,StPt[i].Y] := True;
                   End;
               For J := 1 to X.Picture.Bitmap.Height - 2 do
               Begin
//                    W := X.Picture.Bitmap.ScanLine[J];
                    For I := 1 to X.Picture.Bitmap.Width -2 Do
                        If Fire[J][I*4+2] <>0 Then
                           Begin
                                Change[I,J-1] := True; Change[I-1,J] := True; Change[I+1,J] := True;
                           End;
                    For I := 1 to X.Picture.Bitmap.Width -2 Do
                        If Change[I,J] Then
                           Begin
                                Fire[J][I*4+2] := (Fire[J+1][I*4+2]*2 + Fire[J][(I-1)*4+2] + Fire[J][(I+1)*4+2]) div 4;
                                Change[I,J] := False;
                           End;
               End; //blur

               For I := 1 to X.Picture.Bitmap.Height - 2 Do
                   Begin
                        W := X.Picture.Bitmap.ScanLine[i];
                   For J := 1 to X.Picture.Bitmap.Width - 2 Do
                       Begin
                            //if fire[i][j*4] = 200 then w[j*4+2] := 255 Else w[j*4+2] := fire[i][j*4+2] or base[i][j*4+2];
                            W[J*4+2] := Fire[I][J*4+2] or Base[I][J*4+2];
                            If W[J*4+2] < 50 Then W[J*4+2] := 0;
                            //If base[i][j*4+2] = 0 Then
                               Begin
//                                    w[j*4+1] := Round(w[j*4+2]*(random/5+0.1));
                                    //w[j*4+2] := round(w[j*4+2]*0.99);
                               End;
                       End;
                   End;
          End;


Procedure Feed4(X : TImage ); //internal
          Var
             I,J  : Integer;
             R,W : PByteArray;
             Z   : tByteArray;
             A,B : Integer;
          Begin       //0=blue 1=green 2=red 3=alpha
               If FirePos<X.Picture.Bitmap.Width then Inc(FirePos);
               For I := 0 to High(StPt) Do
                   Begin
                        A := StPt[I].x; B := StPt[I].y;
                        Fire[B][A*4+2] := Random(256);
                   End;
               For J := 1 to X.Picture.Bitmap.Height - 2 do
               Begin
                    For I := 1 to X.Picture.Bitmap.Width -2 Do
                        If Fire[J][I*4+2] <>0 Then
                           Begin
                                Change[I,J-1] := True; Change[I-1,J] := True; Change[I+1,J] := True;
                           End;
                    For I := 1 to X.Picture.Bitmap.Width -2 Do
                        If Change[I,J] Then
                           Begin
                                Fire[J][I*4+2] := (Fire[J+1][I*4+2]*5 + 3*Fire[J][(I-1)*4+2] + 2*Fire[J][(I+1)*4+2]) div 10;
                                Change[I,J] := False;
                           End;
               End; //blur

               For I := 1 to X.Picture.Bitmap.Height - 2 Do
                   Begin
                        W := X.Picture.Bitmap.ScanLine[i];
                        For J := 1 to X.Picture.Bitmap.Width - 2 Do
                            W[J*4+2] := Fire[I][J*4+2] or Base[I][J*4+2];
                   End;
          End;

Procedure FireLine(X : TImage );
          Var
             I,J  : Integer;
             R,W : PByteArray;
             Z   : tByteArray;
             A,B : Integer;
          Begin       //0=blue 1=green 2=red 3=alpha
               If FirePos<X.Picture.Bitmap.Width then Inc(FirePos);
               For I := 0 to High(StPt) Do
                   Begin
                        A := StPt[I].x; B := StPt[I].y;
                        Fire[B][A*4+2] := Random(256) - ABS(Centre-A);
                   End;
               For J := 1 to X.Picture.Bitmap.Height - 2 do
               Begin
                    For I := 1 to X.Picture.Bitmap.Width -2 Do
                        If Fire[J][I*4+2] <>0 Then
                           Begin
                                Change[I,J-1] := True; Change[I-1,J] := True; Change[I+1,J] := True;
                           End;
                    For I := 1 to X.Picture.Bitmap.Width -2 Do
                        If Change[I,J] Then
                           Begin
                                Fire[J][I*4+2] := (Fire[J+1][I*4+2]*5 + 3*Fire[J][(I-1)*4+2] + 2*Fire[J][(I+1)*4+2]) div 10;
                                Change[I,J] := False;
                           End;
               End; //blur

               For I := 1 to X.Picture.Bitmap.Height - 2 Do
                   Begin
                        W := X.Picture.Bitmap.ScanLine[i];
                        For J := 1 to X.Picture.Bitmap.Width - 2 Do
                            If Fire[I][J*4+2] > 100 Then W[J*4+2] := Fire[I][J*4+2] and Base[I][J*4+2];
                   End;
          End;



Procedure Feed(X : TImage );
          Var
             I,J  : Integer;
             R,W : PByteArray;
             Z   : tByteArray;
             A,B,C,D : Integer;
          Begin       //0=blue 1=green 2=red 3=alpha
               If FirePos<X.Picture.Bitmap.Width then Inc(FirePos);
               For I := 0 to High(StPt) Do
                   Begin
                        A := StPt[I].x; B := StPt[I].y;
                        //If Fire[B][A] < 470 Then
                        Begin
                        Fire[B][A] := 64-abs(centre-a) div 4 +Random(700)+100;
                        //If Fire[b][a] = 0 Then Fire[b][a] := Random(150)+200;
                        End;

//                        If sqr(abs(Centre-A)) > Random(256)*RAndom(100) Then Fire[B][A*4+2] := trunc(Fire[B][A*4+2]*Random);
                        //If  Random(256) > RAndom(150) Then Fire[B][A] := trunc(Fire[B][A]*Random);
                   End;


               If (bsSz < 180) and (RAndom(5) = 0) Then
                  Begin
                       Inc(bsSz);
                       SetLength(StPt,2*bsSz+1);
                       StPt[High(StPt)] := Point(Centre-bsSz,lY);
                       StPt[High(StPt)-1] := Point(Centre+bsSz,lY);
                  End;

               For J := 1 to X.Picture.Bitmap.Height - 2 do
               Begin
                    For I := 1 to X.Picture.Bitmap.Width -2 Do
                        If Fire[J][I] <>0 Then
                           Begin
                                Change[I,J-1] := True; Change[I-1,J] := True; Change[I+1,J] := True;
                                Fire[J][I] := round(Fire[J][I]*0.984);
                           End;
                    A := -1;
                    For I := 1 to X.Picture.Bitmap.Width -2 Do
                        If Change[I,J] Then
                           Begin

                                If A = -1 Then A := Fire[J][i-1] Else A := B;
                                B := Fire[J][i];
                                Fire[J][I] := (Fire[J+1][I]*7 + A*2 + Fire[J][(I+1)]*2) div 11;
                                //If (Random(2)=0) AND (Fire[J][I*4+2] < 230) Then Fire[J][I*4+2] := Round(Fire[J][I*4+2]*1.1);
                                If Fire[J][I] < 10 Then Fire[J][i] := 0;
                                //If Random(100) = 0 Then dec(Fire[j][i],Round(Fire[j][i]*0.2));
                                //Fire[J][I] := 500;
                                If Random(200) = 0 Then Inc(Fire[J][I],trunc((800-Fire[J][i])*random*0.01));
                                If Random(300) = 0 Then Fire[j][i] := round(fire[j][i]*0.9);
                                //If (Random(60)=0) aND {(Random(abs(Abs(Centre-I)))=0) AND} (Fire[J][I] < 200) Then Fire[J][i] := trunc(Fire[J][i]*(0.9+random/4));//Inc(Fire[J][i*4+2],Random(50));

                                Change[I,J] := False;
                           End;
               End; //blur
               {For J := 1 to X.Picture.Bitmap.Height - 2 Do
                   Begin A := -1;
                   For I := 1 to X.Picture.Bitmap.Width - 2 Do
                       If Change[I,J] Then
                          Begin
                                If A = -1 Then A := Fire[J][(i-1)*4+2] Else A := B;
                                 B := Fire[J][i*4+2];
                               Fire[J][I*4+2] := (Fire[J+1][I*4+2]*2 + Fire[J][(i-1)*4+2] + Fire[J][(I+1)*4+2]) div 4;

                               //Inc(Fire[J][I*4+2],trunc(0.01*random*Random(255-Fire[J][I*4+2])) );
                               If Fire[J][I*4+2] < 200 Then Fire[J][I*4+2] := Trunc(Fire[J][I*4+2]*1.1);
                               //If (RAndom(200) = 0) and (Fire[J][I*4+2] < 230) Then Inc(Fire[J][I*4+2],Random(5));
                               Change[I,J] := False;
                          End;
                   End;}
               C := Mouse.CursorPos.X; D := Mouse.CursorPos.Y;
               For I := 1 to X.Picture.Bitmap.Height - 2 Do
                   Begin
                        W := X.Picture.Bitmap.ScanLine[i];
                        For J := 10 to X.Picture.Bitmap.Width - 20 Do
                            Begin
                                 //A := (round(sin(I*pi/360)*90)+J)*4;
                                 A := J*4; b := (J+s[(I+Iter) mod 360])*4+2;
                                 W[a+M] := Base[I][b] and ((Fire[I][J] mod 256) or ((Fire[I][J] div 256)*255));//and Base[I][J*4+2];
                                 W[a+N] := (LNO Or Base[I][b]) and ((round(Fire[I][J] / 512) * (Fire[I][J] -256)) or (Fire[I][j] div 512)*255);
                                 W[a+O] := (LnO OR Base[I][b]) and (Fire[i][j] div 512) * (Fire[I][J] -512);
                            End;
                   End;

              Inc(Iter);
          End;

Procedure FeedCrash(X : TImage );
          Var
             I,J  : Integer;
             R,W : PByteArray;
             Z   : tByteArray;
             A,B,C,D : Integer;
          Begin       //0=blue 1=green 2=red 3=alpha
               For I := 0 to High(StPt) Do
                   Begin
                        A := StPt[I].x; B := StPt[I].y;
                        Begin
                        Fire[B][A] := 64-abs(centre-a) div 4 +Random(700)+100;
                        End;
                   End;


               If (bsSz < 180) and (RAndom(5) = 0) Then
                  Begin
                       Inc(bsSz);
                       SetLength(StPt,2*bsSz+1);
                       StPt[High(StPt)] := Point(Centre-bsSz,lY);
                       StPt[High(StPt)-1] := Point(Centre+bsSz,lY);
                  End;

               For J := 1 to X.Picture.Bitmap.Height - 2 do
               Begin
                    For I := 1 to X.Picture.Bitmap.Width -2 Do
                        If Fire[J][I] <>0 Then
                           Begin
                                Change[I,J-1] := True; Change[I-1,J] := True; Change[I+1,J] := True;
                                Fire[J][I] := round(Fire[J][I]*0.984);
                           End;
                    A := -1;
                    For I := 1 to X.Picture.Bitmap.Width -2 Do
                        If Change[I,J] Then
                           Begin

                                If A = -1 Then A := Fire[J][i-1] Else A := B;
                                B := Fire[J][i];
                                Fire[J][I] := (Fire[J+1][I]*7 + A*2 + Fire[J][(I+1)]*2) div 11;
                                //If (Random(2)=0) AND (Fire[J][I*4+2] < 230) Then Fire[J][I*4+2] := Round(Fire[J][I*4+2]*1.1);
                                If Fire[J][I] < 10 Then Fire[J][i] := 0;
                                //If Random(100) = 0 Then dec(Fire[j][i],Round(Fire[j][i]*0.2));
                                //Fire[J][I] := 500;
                                If Random(200) = 0 Then Inc(Fire[J][I],trunc((800-Fire[J][i])*random*0.01));
                                If Random(300) = 0 Then Fire[j][i] := round(fire[j][i]*0.9);
                                //If (Random(60)=0) aND {(Random(abs(Abs(Centre-I)))=0) AND} (Fire[J][I] < 200) Then Fire[J][i] := trunc(Fire[J][i]*(0.9+random/4));//Inc(Fire[J][i*4+2],Random(50));

                                Change[I,J] := False;
                           End;
               End; //blur
               For I := 0 to High(StPt2) Do
                   Begin
                        A := StPt2[I].x; B := StPt2[I].y;
                        Begin
                        Fire2[B][a+s[(b+Iter) mod 360]] := Random(700)+100;
                        End;
                   End;

               For J := 1 to X.Picture.Bitmap.Height - 2 do
               Begin
                    A := -1;
                    For I := 1 to X.Picture.Bitmap.Width -2 Do
                           Begin
                                If A = -1 Then A := Fire2[J][i-1] Else A := B;
                                B := Fire2[J][i];

                                Fire2[J][I] := (Fire2[J+1][I]*7 + A*2 + Fire2[J][(I+1)]*2) div 11;
                           End;

               End;
               For I := 1 to X.Picture.Bitmap.Height - 2 Do
                   Begin
                        W := X.Picture.Bitmap.ScanLine[i];
                        For J := 10 to X.Picture.Bitmap.Width - 20 Do
                            Begin

                                 A := J*4; b := (J+s[(I+Iter) mod 360])*4+2;
                                 W[a+M] := Base[I][b] and ((Fire[I][J] mod 256) or ((Fire[I][J] div 256)*255)) or ((Fire2[I][J] mod 256) or ((Fire2[I][J] div 256)*255));//and Base[I][J*4+2];
                                 W[a+N] := (LNO Or Base[I][b]) and ((round(Fire[I][J] / 512) * (Fire[I][J] -256)) or (Fire[I][j] div 512)*255)
                                           or ((round(Fire2[I][J] / 512) * (Fire2[I][J] -256)) or (Fire2[I][j] div 512)*255);
                                 W[a+O] := (LnO OR Base[I][b]) and (Fire[i][j] div 512) * (Fire[I][J] -512) or (Fire2[i][j] div 512) * (Fire2[I][J] -512);
                            End;
                   End;

              Inc(Iter);
          End;



Procedure RandomLine( X : TImage );
          Var
             I,J  : Integer;
             Line : PByteArray;
          Begin      { //0=blue 1=green 2=red
               For J := 0 to X.Picture.Bitmap.Height - 1 do
               Begin
               Line := X.Picture.Bitmap.ScanLine[J];

               If Line <> nil then For I := 0 to X.Picture.Bitmap.Width - 1 Do
                   Line^[I*4+2] := random(256);
               End; }

               Line := @Base;//X.Picture.Bitmap.ScanLine[X.Picture.Bitmap.Height - 1];
               If Line = nil then showMessage('oops');
               If Line <> nil then For I := 0 to X.Picture.Bitmap.Width - 1 Do
                   Line^[I*4+2] := random(256);

          End;

procedure TForm1.DoClick(Sender: TObject);
Var X, Y : Integer;
begin
     Timer1.Enabled := not Timer1.Enabled;
end;

procedure TForm1.FormCreate(Sender: TObject);
var X, Y : Integer;
begin
     Image1.Autosize := True;
     Image1.Picture.LoadFromFile( 'leaf.bmp' );
     ClientWidth := Image1.Width;
     ClientHeight := Image1.Height;
     Image1.Refresh;
     Image1.Picture.Bitmap.PixelFormat := pf32bit;
              SetLength(Fire,Image1.Height);
              SetLength(Base,Image1.Height);

     lY := 0;
     bsSz := 15;
     Centre := Image1.Width div 2;
     For Y := 0 to Image1.Height -1 Do
         Begin
              For X := 0 to Image1.Width-1 Do
                  Begin
                       Fire[y][X+0] := 0;
                       {Fire[y][4*X+1] := 0;
                       Fire[y][4*X+2] := 0;
                       Fire[y][4*X+3] := 0;}

                       Base[y][4*X+0] := 0;
                       Base[y][4*X+1] := 0;
                       Base[y][4*X+3] := 0;
                       if Image1.Canvas.Pixels[X,Y] mod 256 = 0 Then Base[y][4*x+2] := 0 Else
                          Begin
                               Base[y][4*x+2] := 255;
                               If lY < Y Then lY := y;
                               Image1.Canvas.Pixels[X,Y] := 0;
                          End;
                       If (Image1.Canvas.Pixels[X,Y+1] <> 0) AND (Base[y][4*x+2] = 0) AND (Y <> 433) Then
                          Begin
                               SetLength(StPt2,Length(StPt2)+1);
                               StPt2[High(StPt2)] := Point(X,Y);
                          End;
                  End;
         End;
         SetLength(StPt,2*bsSz+1);
         For X := Centre-bsSz to Centre+bsSz Do
             StPt[X-Centre+bsSz] := Point(X,lY);
end;



procedure TForm1.Iterate(Sender: TObject);
begin
     //RandomLine(Image1);
     Feed(Image1);
     Image1.Refresh;
//     Application.ProcessMessages;
     //Sleep(1);
end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin

     IF KEy = vK_SPACE Then IF BorderStyle = bsSingle Then BorderStyle := bsNOne
                                                      Else BorderStyle := bsSingle;
     If Key = VK_Escape Then Close;
     //Application.ProcessMessages;
     //Repaint;
//     If Borderstyle = bsNone Then Timer1.Enabled := False Else Timer1.Enabled := True;
end;

procedure TForm1.FormKeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
//     BorderStyle := bsNone;
end;

procedure TForm1.FormShow(Sender: TObject);
begin
     Timer1.Enabled := True;
     FirePos:=0;
end;

procedure TForm1.Exit1Click(Sender: TObject);
begin
     Close;
end;

procedure TForm1.PopupMenu1Popup(Sender: TObject);
begin
     //Timer1.Enabled := False;
end;

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
     Timer1.Enabled := Not Timer1.Enabled;
end;

procedure TForm1.BlueLeaf1Click(Sender: TObject);
begin
     M := 0; N := 2; O := 1;
     Timer1.Enabled := True;
end;

procedure TForm1.Normal1Click(Sender: TObject);
begin
    M := 2; N := 1; O := 0;
    Timer1.Enabled := True;
end;

procedure TForm1.LeafOnly1Click(Sender: TObject);
begin
     Lno := Not Lno;
     Timer1.Enabled := true;
end;

Initialization
              Randomize;
              M := 2; N := 1; O := 0;
              For Iter := 0 to 359 Do S[Iter] := Round(30*Sin(Iter*pi/360));
              Iter := 0;              Lno := 255;

end.