unit ufgame_m3;

{$mode delphi}

interface

uses
  Classes, SysUtils, uFGame, uParticles;

type
  TTile_m3 = record
    revX, revY,
    Blink, Cen, Color, Del : Byte;
    X, Y, dX, dY, mX, mY : Integer;
    First, Back,
    Fill, Ready, NeedDraw : Boolean;
  end;

  { TFGame_m3 }

  TFGame_m3 = class(TFGame)

    Map : array of array of TTile_m3;
    Particle : TFig_Proton;
    Fig_Fall : TFig_Fall;
    Fig_Cen  : TFig_Cen;

    EnemyPreTimer, EnemyNoTimer,
    EnemyTimer : Integer;




    Mod_L : Boolean;
    Mod_V : Boolean;

    constructor Create;
    procedure DelTile(pX, pY : Integer; var pTimer : Byte);
    function  TestMap(Line : Boolean; pX, pY : Byte ) : Boolean;
    function  Turn(pX, pY : Byte): Boolean;
    procedure Revert(pX1, pY1, pX2, pY2 : Byte);
    procedure Start(pW, pH : Byte); override;
    procedure Draw; override;
    procedure Update(msX, msY : Integer); override;
    procedure SetTile(pX, pY : Integer);
    procedure Finish(Win : Boolean);
  end;

implementation
uses
  uGlobal, zglHeader, uGUI;
{ TFGame_m3 }

constructor TFGame_m3.Create;
begin
  Particle := TFig_Proton.Create;
  Fig_Fall := TFig_Fall.Create(Particle);
  Fig_Cen  := TFig_Cen.Create(Particle);
end;

procedure TFGame_m3.Start(pW, pH: Byte);
var
  vX, vY, sX, sY : Integer;
begin
  inherited Start(pW, pH);

  Mod_V := true;
  Mod_L := true;

  SetLength(Map, W + 1, H + 1);

  sX := mapX - cRectSize;
  sY := mapY - cRectSize;

  for vX := 1 to W do
  for vY := 1 to H do
  with Map[vX][vY] do
  begin
    X := sX + vX * cRectSize;
    Y := sY + vY * cRectSize;
    SetTile(vX, vY);
  end;


end;

procedure TFGame_m3.DelTile(pX, pY: Integer; var pTimer : Byte);
begin
  with Map[pX][pY] do
  begin
    Fill  := true;
    //Ready := false;
    Del   := 40;
    if   (Color < 7) then
    begin
      Particle.SetSiluet(dX + 2, dY + 2, Color, Siluet[Color]);
      Fig_Fall.Add(dX + 2, dY + 2, Color);
    end;
    if (Cen = 1) and (Color <> 6) then
    begin
      Fig_Cen.Add(dX + 2, dY + 2, pTimer, Color);
      pTimer := pTimer + 1;
    end;
  end;

end;

function TFGame_m3.TestMap(Line: Boolean; pX, pY: Byte): Boolean;
var
  vColor, L : Integer;
  DelTimer : Byte;

  procedure SetColor(tX, tY : Byte);
  begin
    if (Map[tX][tY].Ready or (Line and (tX = pX) and (tY = pY)))
    and Map[tX][tY].Fill then
      vColor := Map[tX][tY].Color
    else
      vColor := 250;
    L := 1;
  end;

  function TestTile(tX, tY, nX, nY : Byte) : Boolean;
  begin
    TestTile := false;
    with Map[tX][tY] do
    if  (Fill)
    and (Ready or (Line and (tX = pX) and (tY = pY)))
    //and not Back
    //and (mX = 0)
    //and (mY = 0)
    and (vColor = Color)
    and (Color < 7) then
    begin
       {if (Map[tX][tY].mY <> 0) and not Line then
       writeln('WRG??!');

       if Map[tX][tY].Back then
       writeln('Back??!');}

       L := L + 1;
       if L > 2 then
       begin
         if not Line then
         begin
           if L = 3 then
           begin
             DelTile(tX - 1 * nX, tY - 1 * nY, DelTimer);
             DelTile(tX - 2 * nX, tY - 2 * nY, DelTimer);
           end;
           DelTile(tX, tY, DelTimer);
         end;

         TestTile := true;
       end;
     end
     else
       SetColor(tX, tY);
     {if Line then
     write('  ',Map[tX][tY].Color, ':', vColor, '  ');  }
  end;

var
  vX, vY, I : Integer;
begin
  DelTimer := 1;
  Result := false;
  if Line then
  begin
    // Result := true;
    //writeln();
    SetColor(pX, 1);
    for I := 2 to H do
    if TestTile(pX, I, 0, 1) then
      Result := true;

    //writeln('H ', Result);

    if not Result then
    begin
      SetColor(1, pY);
      for I := 2 to W do
      if TestTile(I, pY, 1, 0) then
        Result := true;
      //writeln('W ', Result);
    end;

  end
  else
  begin
    for vX := 1 to W do
    begin
      SetColor(vX, 1);
      for I := 2 to H do
      if TestTile(vX, I, 0, 1) then
        Result := true;
    end;

    for vY := 1 to H do
    begin
      SetColor(1, vY);
      for I := 2 to W do
      if TestTile(I, vY, 1, 0) then
        Result := true;
    end;
  end;
end;

function TFGame_m3.Turn(pX, pY: Byte): Boolean;
begin
  Sel := false;
  if ((abs(SelX - pX) = 1) and (SelY = pY))
  or ((abs(SelY - pY) = 1) and (SelX = pX)) then
  begin
    Revert(SelX, SelY, pX, pY);

    if not (TestMap(true, SelX, SelY) or TestMap(true, pX, pY)) then
    begin
      Map[SelX][SelY].First := true;
      Map[SelX][SelY].Back  := true;
      Map[SelX][SelY].revX := pX;
      Map[SelX][SelY].revY := pY;

      Map[pX][pY].First := false;
      Map[pX][pY].Back  := true;
    end;

    hm_mana := hm_mana - 1;
    h_mana  := h_mana - 1;

    result := true;
  end
  else
    result := false;
end;

procedure TFGame_m3.Revert(pX1, pY1, pX2, pY2: Byte);
var
  vColor, vCen : Byte;
begin
  vColor := Map[pX1][pY1].Color;
  vCen   := Map[pX1][pY1].Cen;

  Map[pX1][pY1].Color := Map[pX2][pY2].Color;
  Map[pX1][pY1].Cen := Map[pX2][pY2].Cen;

  Map[pX1][pY1].mX := Map[pX2][pY2].X - Map[pX1][pY1].X;
  Map[pX1][pY1].mY := Map[pX2][pY2].Y - Map[pX1][pY1].Y;

  Map[pX2][pY2].Color := vColor;
  Map[pX2][pY2].Cen := vCen;

  Map[pX2][pY2].mX := -Map[pX1][pY1].mX;
  Map[pX2][pY2].mY := -Map[pX1][pY1].mY;

  Map[pX1][pY1].Ready:=false;
  Map[pX2][pY2].Ready:=false;

  Map[pX1][pY1].Back:=false;
  Map[pX2][pY2].Back:=false;

  Map[pX1][pY1].dX := Map[pX1][pY1].X + Map[pX1][pY1].mX;
  Map[pX1][pY1].dY := Map[pX1][pY1].Y + Map[pX1][pY1].mY;
  Map[pX2][pY2].dX := Map[pX2][pY2].X + Map[pX2][pY2].mX;
  Map[pX2][pY2].dY := Map[pX2][pY2].Y + Map[pX2][pY2].mY;
end;

{
const
  cColor : array[1..7] of integer =
    ($FEFEFE, $FE3131, $31FE31, $3131FE, $FEFE31, $FE31FE, $31FEFE);
}

procedure TFGame_m3.Draw;
var
  vX, vY, BA : Integer;
begin
  for vX := 1 to W do
  for vY := 1 to H do
  with Map[vX][vY] do
  begin
    BA := Alpha + Blink;
    if BA > 160 then
      BA := 160;
    pr2d_Rect(X, Y, cRectSize, cRectSize, $010102, Alpha, PR2D_FILL);
    pr2d_Rect(X, Y, cRectSize, cRectSize, $F1F1F2, Blink, PR2D_FILL);
    pr2d_Rect(X, Y, cRectSize, cRectSize, $303040, Alpha);
  end;

  if Sel then
  with Map[SelX][SelY] do
    pr2d_Rect(X, Y, cRectSize, cRectSize, $FFFFFF, Alpha);

  for vX := 1 to W do
  for vY := 1 to H do
  with Map[vX][vY] do
  if Fill and NeedDraw then
  //  pr2d_Circle(dX + cRectSize/2, dY + cRectSize /2, cRectSize/3, cColor[Color], $FF, 32, PR2D_FILL);
  if Del = 0 then
    sFig[Color].Draw(dX + 2, dY + 2, Cen, Alpha)
  else
    sFig[Color].Draw(dX + 2, dY + 2, Cen, (Del - 30)*255);

  if (EnemyTimer > 0) then
    pr2d_Rect(MapX, MapY, MapW, MapH, $F1F1F2, EnemyTimer div 2, PR2D_FILL);
  if (EnemyPreTimer > 0) then
    pr2d_Rect(MapX, MapY, MapW, MapH, $F1F1F2, (cEnemyTimer - EnemyPreTimer) div 2, PR2D_FILL);
  if (EnemyNoTimer > 0) then
    pr2d_Rect(MapX, MapY, MapW, MapH, $F1F1F2, (EnemyNoTimer) div 2, PR2D_FILL);

  Particle.Draw;
  Fig_Fall.Draw;
  Fig_Cen.Draw;

  text_Draw(mFont, 10, 128 + 1 * 25, 'hm_live: ' + IntToStr(hm_live));
  text_Draw(mFont, 10, 128 + 2 * 25, 'hm_exp: ' + IntToStr(hm_exp));
  text_Draw(mFont, 10, 128 + 3 * 25, 'hm_mana: ' + IntToStr(hm_mana));
  text_Draw(mFont, 10, 128 + 4 * 25, 'hm_sh: ' + IntToStr(hm_sh));
  text_Draw(mFont, 10, 128 + 6 * 25, 'em_live: ' + IntToStr(em_live));
  text_Draw(mFont, 10, 128 + 7 * 25, 'em_heart: ' + IntToStr(em_heart));

{
  for vX := 1 to W do
  for vY := 1 to H do
  with Map[vX][vY] do
  begin
    if Ready then
      text_Draw(mFont, dX, dY, 'R')
    else
      text_Draw(mFont, dX, dY, '-');
    text_Draw(mFont, dX, dY + 20, 'del: ' + IntToStr(Del));
    if Back then
      text_Draw(mFont, dX, dY + 40, 'Back')
    else
      text_Draw(mFont, dX, dY + 40, '-');
  end;   }
end;

procedure TFGame_m3.Update(msX, msY : Integer);
var
  DelTimer,
  vX, vY, vY1 : Byte;
  //ReadyToTest : Boolean;
begin
  if Disable then
  begin
    if Alpha > 5 then
      Alpha := Alpha - 5;
    Exit;
  end
  else
  if Alpha < 250 then
    Alpha := Alpha + 5;

  if (e_live <= 0) or (e_heart >= e_max_heart) then
    Finish(true)
  else
  if (h_live <= 0) and (h_sh <= 0) then
    Finish(false);


  if EnemyTimer > 0 then
  begin
    EnemyTimer := EnemyTimer - 1;
    if EnemyTimer <= 0 then
    begin
      h_mana := h_max_mana;
      hm_mana := h_mana;
    end;
  end
  else
  begin
    if EnemyNoTimer > 0 then
      EnemyNoTimer := EnemyNoTimer - 4;

    if EnemyPreTimer > 0 then
    begin
      EnemyPreTimer := EnemyPreTimer - 2;

      if (hm_mana > 0) then
      begin
        EnemyNoTimer := EnemyPreTimer;
        EnemyPreTimer := 0;
      end
      else
      if (EnemyPreTimer <= 0) then
      begin
        EnemyTimer := cEnemyTimer;
        Fig_Cen.Add(WinW - 64, 8 + 64 - 25, 0, 6);
      end;
    end
    else
    if hm_mana <= 0 then
      EnemyPreTimer := cEnemyTimer;

  end;


  msX := (msX - MapX) div cRectSize + 1;
  msY := (msY - MapY) div cRectSize + 1;

  if  (msX > 0) and (msX <= W)
  and (msY > 0) and (msY <= H)
  and (Map[msX][msY].Ready and Map[msX][msY].Fill)
  then
  begin
    with Map[msX][msY] do
    if Blink < 170 then
      Blink := Blink + 10;

    if mouse_Click(M_BLEFT) and (EnemyTimer <= 0) then
    begin
      if not Sel
      or not Turn(msX, msY) then
       Select(msX, msY);
    end;
  end;



  //ReadyToTest := true;
  for vX := 1 to W do
  for vY := 1 to H do
  with Map[vX][vY] do
  begin
    if Del > 0 then
    begin
      Del := Del - 1;
      if Del = 30 then
        NeedDraw := false;
      if Del > 25 then
      begin
        if Color < 7 then
          Particle.SetSiluet(dX + 2, dY + 2, Color, Siluet[Color]);
      end
      else
      if Del = 0 then
        Fill := false;
    end;

    Ready := (mX = 0) and (mY = 0) and (Del = 0);

    if Ready and Back then
    begin
      Ready := false;
      if First then
        Revert(vX, vY, revX, revY);
    end;

    {if not Ready then
      ReadyToTest := false; }

    if Ready then
    begin
      vY1 := vY - 1;
      if  (vY > 1)
      and (not Fill)
      and Map[vX][vY1].Fill
      and Map[vX][vY1].Ready then
      begin
        Color := Map[vX][vY1].Color;
        Cen   := Map[vX][vY1].Cen;
        NeedDraw  := Map[vX][vY1].NeedDraw;
        Fill  := true;
        mY    := Map[vX][vY1].Y - Y;
        Ready := false;
        Map[vX][vY1].Fill := false;
        Map[vX][vY1].Ready := false;
      end;
    end;

    if mX <> 0 then
    begin
      if mX > 0 then mX := mX - 2
      else
      if mX < 0 then mX := mX + 2;
      dX := X + mX;
    end
    else
      dX := X;

    if mY <> 0 then
    begin
      if mY > 0 then mY := mY - 2
      else
      if mY < 0 then mY := mY + 2;
      dY := Y + mY;
    end
    else
      dY := Y;

    if Blink > 5 then
      Blink := Blink - 5;
  end;

  //if ReadyToTest then
     TestMap(false, 0, 0);

  for vX := 1 to W do
  if Map[vX][1].Fill = false then
    SetTile(vX, 1);

  DelTimer := 1;
  for vX := 1 to W do
  if  (Map[vX][H].Fill)
  and (Map[vX][H].Ready)
  and (Map[vX][H].Color = 7) then
    DelTile(vX, H, DelTimer);

  Particle.Update;
  Fig_Fall.Update;
  Fig_Cen.Update;


end;

procedure TFGame_m3.SetTile(pX, pY: Integer);
begin
  with Map[pX][pY] do
  begin
    mX := 0;
    mY := -cRectSize;
    dX := X;
    dY := Y + mY;

    if (random < 0.72) then
      Cen := 0
    else
      Cen := 1;

    if (Mod_L) and (random > 0.88) then
    begin
      Cen := 1;
      Color := 7;
    end
    else
    if pY = 1 then
    begin
    repeat
      Color := random(6) + 1;
    until (Map[pX][2].Color <> Color)
       or (Map[pX][3].Color <> Color);
    end
    else
      Color := random(6) + 1;

    if (not Mod_V) and (Color = 2) then
      Cen := 0;

    Fill := true;
    Ready := false;
    Del := 0;
    NeedDraw := true;
  end;
end;

procedure TFGame_m3.Finish(Win: Boolean);
begin
  Disable := true;
  Alpha := 250;
  GWin := Win;
end;

end.

