const W = 640-1;
      H = 480-1;

//Sand array - the heart of engine. A = Type; Active - Physics enabled (dynamic!)
Sand : array[0..W,0..H] of record A : Integer; Active : Boolean; end;
//Was this sand cell processed already?
ID : array[0..W,0..H] of Boolean;
//If this is a solid wall
Solid : array[0..W,0..H] of Boolean;

//Everything is in special units
//Friction is 0..8, everything else makes it go crazy
                                           //Void    Sand     Water   Concr.  Cement  Acid    Dirt
const Colors    : array[0..6] of Integer = ($000000, $AFAF00, $0000AF,$4F4F4F,$AFAFAF,$00AF00,$7F3F00);
      Friction  : array[0..6] of Integer = (0      , 2      , 8      , 0     , 0     , 8     , 1     );
      Density   : array[0..6] of Integer = (0      , 200    , 100    , 50    , 150   , 50    , 250   );
      Liquid    : array[0..6] of Boolean = (False  , False  , True   , False , False , True  , False );

const DissolveTable : array[0..6,0..6] of Integer =
//Void    Sand    Water   Concr.  Cement Acid    Dirt
((0      ,0      ,0      ,0      ,0      ,0      ,0      ), //Void
 (0      ,0      ,0      ,0      ,0      ,0      ,0      ), //Sand
 (0      ,500    ,0      ,0      ,100    ,0      ,300    ), //Water
 (0      ,0      ,0      ,0      ,0      ,0      ,0      ), //Concrete
 (0      ,0      ,0      ,0      ,0      ,0      ,0      ), //Cement
 (0      ,100    ,50     ,100    ,20     ,0      ,150    ), //Acid
 (0      ,0      ,0      ,0      ,0      ,0      ,0      ));//Dirt



//Repeated 4 times per 25msec (steady 30FPS framerate)
procedure PhysicsStep0;
var X,Y,K,F : Integer;
    L,R : Boolean;
begin
  //Init ID, determine whether to calculate Sand[x,y]
  for x := 1 to High(Sand)-1 do
    for y := 1 to High(Sand[0])-1 do begin
      ID[x,y] := False;
      Sand[x,y].Active := not((Sand[x-1,y].A = Sand[x,y].A) and (Sand[x,y+1].A = Sand[x,y].A) and
                              (Sand[x+1,y].A = Sand[x,y].A) and (Sand[x,y-1].A = Sand[x,y].A));
      if Sand[x,y].Active and ((DissolveTable[Sand[x,y].A,Sand[x-1,y].A] = 0) and
                               (DissolveTable[Sand[x,y].A,Sand[x+1,y].A] = 0) and
                               (DissolveTable[Sand[x,y].A,Sand[x,y-1].A] = 0) and
                               (DissolveTable[Sand[x,y].A,Sand[x,y+1].A] = 0) and
                               (Sand[x-1,y].A > 0) and
                               (Sand[x+1,y].A > 0) and
                               (Sand[x,y-1].A > 0) and
                               (Sand[x,y+1].A > 0)) then
        Sand[x,y].Active := False;
    end;

  //Rawr
  for x := 1 to High(Sand)-1 do
    for y := 1 to High(Sand[0])-1 do begin
      Inc(FrameIterations);
      if (not Solid[x,y]) and (Sand[x,y].A > 0) then //This is particle
        Inc(Particles);

      if (not Solid[x,y]) and (Sand[x,y].A > 0) and (Sand[x,y].Active) then begin //This is active particle
        Inc(ActiveParticles);
        if (not ID[x,y]) and (not ID[x,y+1]) and (Sand[x,y+1].A = 0) then begin //Gravity cat fix
          Sand[x,y+1] := Sand[x,y];
          Sand[x,y].A := 0;
          ID[x,y] := True;
          ID[x,y+1] := True;
        end;

        if Liquid[Sand[x,y+1].A] and (not ID[x,y]) and (not ID[x,y+1]) and (Sand[x,y+1].A > 0) then begin //Liquid physics
          if (Density[Sand[x,y].A] > Density[Sand[x,y+1].A]) and (Random(5) = 0) then begin
            K := Sand[x,y+1].A;
            Sand[x,y+1] := Sand[x,y];
            Sand[x,y].A := K;
            ID[x,y] := True;
            ID[x,y+1] := True;
          end;
        end;

        //Dissolve check [EXTREMLY SUCKY VERSION]
        if (DissolveTable[Sand[x,y].A,Sand[x,y+1].A]) > 0 then begin
          if (Random(DissolveTable[Sand[x,y].A,Sand[x,y+1].A]) = 0) then begin
            Sand[x,y+1].A := 0;
          end;
        end;

        if (DissolveTable[Sand[x,y].A,Sand[x,y-1].A]) > 0 then begin
          if (Random(DissolveTable[Sand[x,y].A,Sand[x,y-1].A]) = 0) then begin
            Sand[x,y-1].A := 0;
          end;
        end;

        if (DissolveTable[Sand[x,y].A,Sand[x+1,y].A]) > 0 then begin
          if (Random(DissolveTable[Sand[x,y].A,Sand[x+1,y].A]) = 0) then begin
            Sand[x+1,y].A := 0;
          end;
        end;

        if (DissolveTable[Sand[x,y].A,Sand[x-1,y].A]) > 0 then begin
          if (Random(DissolveTable[Sand[x,y].A,Sand[x-1,y].A]) = 0) then begin
            Sand[x-1,y].A := 0;
          end;
        end;

        //Friction
        F := Friction[Sand[x,y].A] - Random(Friction[Sand[x,y].A] div 4);

        if (not ID[x,y]) then begin //If this sand was not processed
          K := Random(3); //Move left or right or dont move at all
          L := (x-f >= 0) and (not ID[x-F,y]) and (Sand[x-F,y].A = 0); //Can move left
          R := (x+f <= High(Sand)) and (not ID[x+F,y]) and (Sand[x+F,y].A = 0); //Can move right

          if (K = 0) then begin //Fix direction 0 (left)
            if (not L) and (R) then K := 1;
            if (not L) and (not R) then K := -1; //Cant move
          end;
          if (K = 1) then begin //Fix direction 1 (right)
            if (not R) and (L) then K := 0;
            if (not R) and (not L) then K := -1; //Cant move
          end;

          if (x-f >= 0) and (Random(2) = 0) and (not ID[x-F,y+1]) and (Sand[x-F,y+1].A = 0) and (R) then begin //Priority to move left/down
            K := 0;
          end;
          if (x+f <= High(Sand)) and (Random(2) = 0) and (not ID[x+F,y+1]) and (Sand[x+F,y+1].A = 0) and (L) then begin //Priority to move right/down
            K := 1;
          end;

          if (x-f >= 0) and (K = 0) and (Sand[x-F,y].A = 0) then begin //Move left
            Sand[x-F,y] := Sand[x,y];
            Sand[x,y].A := 0;
            ID[x-F,y] := True;
            ID[x,y] := True;
          end;
          if (x+f <= High(Sand)) and (K = 1) and (Sand[x+F,y].A = 0) then begin //Move right
            Sand[x+F,y] := Sand[x,y];
            Sand[x,y].A := 0;
            ID[x+F,y] := True;
            ID[x,y] := True;
          end;
          if (K = -1) then begin //If we did not move, still process
            ID[x,y] := True;
          end;
        end;
      end;
    end;

  if not bBorders then begin //Borders enabled
    for X := 1 to High(Sand)-1 do begin
      Sand[x,High(Sand[0])-1].A := 0;
      Sand[x,1].A := 0;
    end;
    for Y := 1 to High(Sand[0])-1 do begin
      Sand[High(Sand)-1,y].A := 0;
      Sand[1,y].A := 0;
    end;
  end;
end;

//NOTICE ON DRAWING:
//DONT DRAW BORDER OF 1 PIXEL - IT MAY LOOK UGLY. OR MAY NOT.